Source code of file oscpmwin_v0.1.2.450/dataman.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003,2004,2005 by Mario A. Valdez-Ramirez.
0003:
0004: You can contact Mario A. Valdez-Ramirez
0005: by email at mario@mariovaldez.org or paper mail at
0006: Olmos 809, San Nicolas, NL. 66495, Mexico.
0007:
0008: This program is free software; you can redistribute it and/or modify
0009: it under the terms of the GNU General Public License as published by
0010: the Free Software Foundation; either version 2 of the License, or (at
0011: your option) any later version.
0012:
0013: This program is distributed in the hope that it will be useful, but
0014: WITHOUT ANY WARRANTY; without even the implied warranty of
0015: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0016: General Public License for more details.
0017:
0018: You should have received a copy of the GNU General Public License
0019: along with this program; if not, write to the Free Software
0020: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0021: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0022: unit dataman;
0023:
0024: interface
0025:
0026: USES SysUtils, Graphics, Classes;
0027:
0028: CONST
0029: opmC_ValIsInteger = 1;
0030: opmC_ValIsCurrency = 2;
0031: opmC_ValIsNumOp = 3;
0032: opmC_ValIsIntegerEmpty = 4;
0033: opmC_ValIsCurrencyEmpty = 5;
0034: opmC_Valid_IntChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-'];
0035: opmC_Valid_RealChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-', '.'];
0036: opmC_Valid_NumOpChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-', '.', '%'];
0037: opmC_Valid_UploadChars = ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_'];
0038: opmC_Valid_HexChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', 'A', 'B', 'C', 'D', 'E', 'F'];
0039: opmC_Valid_HostChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-'];
0040: opmC_Fallback_Year = 1990;
0041: opmC_Fallback_Month = 1;
0042: opmC_Fallback_Day = 1;
0043: opmC_Fallback_Hour = 12;
0044: opmC_Fallback_Minute = 0;
0045: opmC_NullColor_HexString = '000000';
0046: opmC_CompNullColor_HexString = 'FFFFFF';
0047: opmC_ColorHighOffest = 25;
0048: opmC_VersionIsOlder = -1;
0049: opmC_VersionIsEqual = 0;
0050: opmC_VersionIsNewer = 1;
0051:
0052:
0053:
0054:
0055: FUNCTION FNopm_CleanUploadName (Str2Clean : STRING) : STRING;
0056: FUNCTION FNopm_CleanHostName (Str2Clean : STRING) : STRING;
0057: FUNCTION FNopm_CleanSQLString (Str2Clean : STRING; Searching : BOOLEAN) : STRING;
0058: FUNCTION FNopm_NoCRLF (Str2Clean : STRING) : STRING;
0059: FUNCTION FNopm_CleanNumber (SourceValue : STRING; ValueType : INTEGER) : STRING;
0060: FUNCTION FNopm_StrToInt (SourceValue : STRING) : LONGINT;
0061: FUNCTION FNopm_CleanHexNumber (SourceValue : STRING; NumberLen : WORD) : STRING;
0062: FUNCTION FNopm_CleanString (Str2Clean : STRING) : STRING;
0063: FUNCTION FNopm_GetTemporaryPath : STRING;
0064: FUNCTION FNopm_RunExternalApp (ExeFileName, ExeParams, RunDirectory : STRING; WaitApp, ShowApp : BOOLEAN; WaitForIdle : LONGINT): CARDINAL;
0065: PROCEDURE PRopm_StopExternalApp (AppHandle : CARDINAL);
0066: PROCEDURE PRopm_StopExternalAppByName (AppTitle : STRING);
0067: FUNCTION FNopm_GetWindowsVersion : STRING;
0068: FUNCTION FNopm_GetBuildVersion (FullString : BOOLEAN) : STRING;
0069: FUNCTION FNopm_ColorToRGB (CurColor : TColor) : STRING;
0070: FUNCTION FNopm_ColorToDecColor (CurColor : TColor) : LONGINT;
0071: FUNCTION FNopm_DecColorToColor (DecColor : LONGINT) : TColor;
0072: FUNCTION FNopm_ComplementaryColor (CurColor : LONGINT) : TColor;
0073: FUNCTION FNopm_HighlightColor (CurColor : LONGINT) : TColor;
0074: FUNCTION FNopm_StripHTML (SourceHTML : STRING) : STRING;
0075: FUNCTION FNopm_StringToDate (DateStr : STRING) : TDATETIME;
0076: FUNCTION FNopm_DateToString (DateDate : TDATETIME) : STRING;
0077: FUNCTION FNopm_IsAppRunning (AppTitle : STRING) : BOOLEAN;
0078: FUNCTION FNopm_StringFromResource (ResName : PCHAR) : STRING;
0079: FUNCTION FNopm_GetMemoryLoad : LONGINT;
0080: FUNCTION FNopm_CheckLanguage (LangISOID : STRING) : BOOLEAN;
0081: PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet);
0082: FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0083: FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0084: FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING;
0085: FUNCTION opm_FNMD5 (Str2Hash : STRING) : STRING;
0086: FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER;
0087: FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING;
0088:
0089:
0090: VAR
0091: opmG_Fallback_DateTime : TDATETIME;
0092: opmG_ExeBuildVersion : STRING;
0093: opmG_PlatformVersion : STRING;
0094:
0095: implementation
0096:
0097: USES Windows, ShellApi, Messages, Forms, DateUtils, oscpmdata, gnugettext, IdHashMessageDigest, StrUtils;
0098:
0099:
0100: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0101: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0102: FUNCTION FNopm_CleanUploadName (Str2Clean : STRING) : STRING;
0103: VAR
0104: TmpStr : STRING;
0105: StrCount : WORD;
0106: BEGIN
0107: TmpStr := '';
0108: Str2Clean := TRIM (Str2Clean);
0109: Str2Clean := ANSIREPLACESTR (Str2Clean, ' ', '_');
0110: Str2Clean := ANSIREPLACESTR (Str2Clean, '-', '_');
0111: FOR StrCount := 1 TO LENGTH (Str2Clean) DO
0112: IF (Str2Clean[StrCount] IN opmC_Valid_UploadChars) THEN
0113: TmpStr := TmpStr + Str2Clean[StrCount];
0114: FNopm_CleanUploadName := TmpStr;
0115: END;
0116:
0117:
0118: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0119: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0120: FUNCTION FNopm_CleanHostName (Str2Clean : STRING) : STRING;
0121: VAR
0122: TmpStr : STRING;
0123: StrCount : WORD;
0124: BEGIN
0125: TmpStr := '';
0126: FOR StrCount := 1 TO LENGTH (Str2Clean) DO
0127: IF (Str2Clean[StrCount] IN opmC_Valid_HostChars) THEN
0128: TmpStr := TmpStr + Str2Clean[StrCount];
0129: FNopm_CleanHostName := TmpStr;
0130: END;
0131:
0132:
0133: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0134: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0135: FUNCTION FNopm_CleanSQLString (Str2Clean : STRING; Searching : BOOLEAN) : STRING;
0136: BEGIN
0137: Str2Clean := ANSIREPLACESTR (Str2Clean, '--', '-');
0138: Str2Clean := ANSIREPLACESTR (Str2Clean, '\', '\\');
0139: Str2Clean := ANSIREPLACESTR (Str2Clean, '"', '\"');
0140: Str2Clean := ANSIREPLACESTR (Str2Clean, '''', '\''');
0141: Str2Clean := ANSIREPLACESTR (Str2Clean, #13, '\r');
0142: Str2Clean := ANSIREPLACESTR (Str2Clean, #10, '\n');
0143: Str2Clean := ANSIREPLACESTR (Str2Clean, #26, '');
0144: Str2Clean := ANSIREPLACESTR (Str2Clean, #8, '');
0145: Str2Clean := ANSIREPLACESTR (Str2Clean, #9, ' ');
0146: IF (Searching = TRUE) THEN
0147: BEGIN
0148: Str2Clean := ANSIREPLACESTR (Str2Clean, '%', '\%');
0149: Str2Clean := ANSIREPLACESTR (Str2Clean, '_', '\_');
0150: END;
0151: FNopm_CleanSQLString := TRIM (Str2Clean);
0152: END;
0153:
0154:
0155: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0156: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0157: FUNCTION FNopm_NoCRLF (Str2Clean : STRING) : STRING;
0158: BEGIN
0159: Str2Clean := ANSIREPLACESTR (Str2Clean, #13, '');
0160: Str2Clean := ANSIREPLACESTR (Str2Clean, #10, '');
0161: Str2Clean := ANSIREPLACESTR (Str2Clean, #26, '');
0162: Str2Clean := ANSIREPLACESTR (Str2Clean, #8, '');
0163: Str2Clean := ANSIREPLACESTR (Str2Clean, #9, '');
0164: FNopm_NoCRLF := TRIM (Str2Clean);
0165: END;
0166:
0167:
0168: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0169: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0170: FUNCTION FNopm_CleanString (Str2Clean : STRING) : STRING;
0171: VAR
0172: TmpStr : STRING;
0173: BEGIN
0174: REPEAT
0175: TmpStr := Str2Clean;
0176: Str2Clean := ANSIREPLACESTR (Str2Clean, ' ', ' ');
0177: UNTIL (TmpStr = Str2Clean);
0178: Str2Clean := ANSIREPLACESTR (Str2Clean, #9, '');
0179: FNopm_CleanString := TRIM (Str2Clean);
0180: END;
0181:
0182:
0183: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0184: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0185: FUNCTION FNopm_CleanNumber (SourceValue : STRING; ValueType : INTEGER) : STRING;
0186: VAR
0187: CurrChar : WORD;
0188: TargetStr : STRING;
0189: BEGIN
0190: TargetStr := '';
0191: SourceValue := TRIM (SourceValue);
0192: IF ((SourceValue = '') AND ((ValueType = opmC_ValIsCurrencyEmpty) OR (ValueType = opmC_ValIsIntegerEmpty))) THEN
0193: TargetStr := ''
0194: ELSE
0195: CASE ValueType OF
0196: opmC_ValIsInteger, opmC_ValIsIntegerEmpty:
0197: BEGIN
0198: FOR CurrChar := 1 TO LENGTH (SourceValue) DO
0199: IF (SourceValue[CurrChar] IN opmC_Valid_IntChars) THEN TargetStr := TargetStr + SourceValue[CurrChar] ELSE BREAK;
0200: TRY
0201: TargetStr := INTTOSTR (STRTOINT (TargetStr));
0202: EXCEPT
0203: TargetStr := '0';
0204: END;
0205: END;
0206: opmC_ValIsCurrency, opmC_ValIsCurrencyEmpty:
0207: BEGIN
0208: FOR CurrChar := 1 TO LENGTH (SourceValue) DO
0209: IF (SourceValue[CurrChar] IN opmC_Valid_RealChars) THEN TargetStr := TargetStr + SourceValue[CurrChar];
0210: TRY
0211: TargetStr := CURRTOSTRF (STRTOCURR (TargetStr), ffFixed, 2);
0212: EXCEPT
0213: TargetStr := '0.00';
0214: END;
0215: END;
0216: opmC_ValIsNumOp:
0217: BEGIN
0218: FOR CurrChar := 1 TO LENGTH (SourceValue) DO
0219: IF (SourceValue[CurrChar] IN opmC_Valid_NumOpChars) THEN
0220: TargetStr := TargetStr + SourceValue[CurrChar];
0221: END;
0222: END;
0223: FNopm_CleanNumber := TargetStr;
0224: END;
0225:
0226:
0227: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0228: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0229: FUNCTION FNopm_StrToInt (SourceValue : STRING) : LONGINT;
0230: VAR
0231: CurrChar : WORD;
0232: TargetStr : STRING;
0233: TargetInt : LONGINT;
0234: BEGIN
0235: TargetStr := '';
0236: SourceValue := TRIM (SourceValue);
0237: FOR CurrChar := 1 TO LENGTH (SourceValue) DO
0238: IF (SourceValue[CurrChar] IN opmC_Valid_IntChars) THEN TargetStr := TargetStr + SourceValue[CurrChar] ELSE BREAK;
0239: TRY
0240: TargetInt := STRTOINT (TargetStr);
0241: EXCEPT
0242: TargetInt := 0;
0243: END;
0244: FNopm_StrToInt := TargetInt;
0245: END;
0246:
0247:
0248: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0249: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0250: FUNCTION FNopm_CleanHexNumber (SourceValue : STRING; NumberLen : WORD) : STRING;
0251: VAR
0252: TmpStr : STRING;
0253: StrCount : WORD;
0254: BEGIN
0255: TmpStr := '';
0256: SourceValue := ANSIUPPERCASE (SourceValue);
0257: FOR StrCount := 1 TO LENGTH (SourceValue) DO
0258: IF (SourceValue[StrCount] IN opmC_Valid_HexChars) THEN
0259: TmpStr := TmpStr + SourceValue[StrCount];
0260: IF (LENGTH (TmpStr) >= NumberLen) THEN
0261: SourceValue := COPY (TmpStr, 1, NumberLen)
0262: ELSE
0263: SourceValue := STRINGOFCHAR ('0', NumberLen - LENGTH (TmpStr)) + TmpStr;
0264: FNopm_CleanHexNumber := SourceValue;
0265: END;
0266:
0267:
0268:
0269: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0270: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0271: FUNCTION FNopm_GetTemporaryPath : STRING;
0272: VAR
0273: TmpDir : STRING;
0274: BufSize : DWORD;
0275: BEGIN
0276: SETLENGTH (TmpDir, MAX_PATH);
0277: BufSize := GetTempPath (MAX_PATH, PCHAR (TmpDir));
0278: SETLENGTH (TmpDir, BufSize);
0279: FNopm_GetTemporaryPath := TmpDir;
0280: END;
0281:
0282:
0283:
0284:
0285: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0286: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0287: FUNCTION FNopm_RunExternalApp (ExeFileName, ExeParams, RunDirectory : STRING; WaitApp, ShowApp : BOOLEAN; WaitForIdle : LONGINT): CARDINAL;
0288: VAR
0289: MsgInfo: TMsg;
0290: ExeInfo : TShellExecuteInfo;
0291: ExitCode : DWORD;
0292: BEGIN
0293: ExeInfo.cbSize := SIZEOF (ExeInfo);
0294: ExeInfo.fMask := (SEE_MASK_NOCLOSEPROCESS OR SEE_MASK_FLAG_NO_UI);
0295: ExeInfo.wnd := Application.Handle;
0296: ExeInfo.lpVerb := 'open';
0297: ExeInfo.lpFile := PCHAR (ExeFileName);
0298: ExeInfo.lpParameters := PCHAR (ExeParams);
0299: ExeInfo.lpDirectory := PCHAR (RunDirectory);
0300: IF (ShowApp = FALSE) THEN
0301: ExeInfo.nShow := SW_HIDE { SW_SHOWMINNOACTIV ??? }
0302: ELSE
0303: ExeInfo.nShow := SW_SHOWNORMAL; { SW_SHOWDEFAULT ??? }
0304: IF (ShellExecuteEx (@ExeInfo) = TRUE) THEN
0305: BEGIN
0306: IF (WaitApp = TRUE) THEN
0307: BEGIN
0308: REPEAT
0309: WHILE (PeekMessage (MsgInfo, 0, 0, 0, PM_REMOVE) = TRUE) DO
0310: BEGIN
0311: IF (MsgInfo.Message = WM_QUIT) THEN Halt (MsgInfo.WParam);
0312: TranslateMessage (MsgInfo);
0313: DispatchMessage (MsgInfo);
0314: END;
0315: UNTIL (WaitForSingleObject (ExeInfo.hProcess, 50) <> WAIT_TIMEOUT);
0316: GetExitCodeProcess (ExeInfo.hProcess, ExitCode);
0317: CloseHandle (ExeInfo.hProcess);
0318: FNopm_RunExternalApp := ExitCode;
0319: END
0320: ELSE
0321: BEGIN
0322: IF (WaitForIdle > 0) THEN WaitForInputIdle (ExeInfo.hProcess, WaitForIdle);
0323: FNopm_RunExternalApp := ExeInfo.hProcess;
0324: END;
0325: END
0326: ELSE FNopm_RunExternalApp := 0;
0327: end;
0328:
0329:
0330:
0331: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0332: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0333: PROCEDURE PRopm_StopExternalApp (AppHandle : CARDINAL);
0334: BEGIN
0335: IF (AppHandle > 0) THEN
0336: IF (TerminateProcess (AppHandle, ExitCode) = TRUE)
0337: THEN CloseHandle (AppHandle);
0338: end;
0339:
0340:
0341:
0342:
0343: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0344: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0345: PROCEDURE PRopm_StopExternalAppByName (AppTitle : STRING);
0346: VAR
0347: WindowHandle: HWND;
0348: WindowTitle: ARRAY [0..255] of CHAR;
0349: ProcID : CARDINAL;
0350: ProcHandle : CARDINAL;
0351: BEGIN
0352: WindowHandle := GetWindow (Application.Handle, GW_HWNDFIRST);
0353: WHILE (WindowHandle > 0) DO
0354: BEGIN
0355: FillChar (WindowTitle, LENGTH (WindowTitle), #0);
0356: GetWindowText (WindowHandle, WindowTitle, LENGTH (WindowTitle) - 1);
0357: IF (ANSIPOS (ANSIUPPERCASE (AppTitle), ANSIUPPERCASE (STRING (WindowTitle))) > 0) THEN
0358: BEGIN
0359: GetWindowThreadProcessId (WindowHandle, @ProcID);
0360: ProcHandle := OpenProcess (PROCESS_TERMINATE, FALSE, ProcID);
0361: TerminateProcess (ProcHandle, 0);
0362: CloseHandle (ProcHandle);
0363: BREAK;
0364: END
0365: ELSE WindowHandle := GetWindow (WindowHandle, GW_HWNDNEXT);
0366: END;
0367: END;
0368:
0369:
0370:
0371:
0372:
0373:
0374:
0375: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0376: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0377: FUNCTION FNopm_GetWindowsVersion : STRING;
0378: VAR
0379: VerInfo : OSVERSIONINFO;
0380: BEGIN
0381: VerInfo.dwOSVersionInfoSize := SIZEOF (OSVERSIONINFO);
0382: GetVersionEx (VerInfo);
0383: FNopm_GetWindowsVersion := 'Windows ' + INTTOSTR (VerInfo.dwMajorVersion) + '.' + INTTOSTR (VerInfo.dwMinorVersion) + ' build ' + INTTOSTR (VerInfo.dwBuildNumber) + ' ' + VerInfo.szCSDVersion;
0384: END;
0385:
0386:
0387:
0388: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0389: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0390: FUNCTION FNopm_GetBuildVersion (FullString : BOOLEAN) : STRING;
0391: VAR
0392: VerInfoSize: DWORD;
0393: VerInfo: POINTER;
0394: VerValueSize: DWORD;
0395: VerValue: PVSFixedFileInfo;
0396: Dummy: DWORD;
0397: VerString : STRING;
0398: BEGIN
0399: VerString := '';
0400: VerInfoSize := GetFileVersionInfoSize (PChar (Application.ExeName), Dummy);
0401: GetMem (VerInfo, VerInfoSize);
0402: GetFileVersionInfo (PChar (ParamStr (0)), 0, VerInfoSize, VerInfo);
0403: VerQueryValue (VerInfo, '\', Pointer (VerValue), VerValueSize);
0404: IF (FullString = TRUE) THEN
0405: BEGIN
0406: VerString := VerString + INTTOSTR (VerValue^.dwFileVersionMS SHR 16) + '.';
0407: VerString := VerString + INTTOSTR (VerValue^.dwFileVersionMS AND $FFFF) + '.';
0408: VerString := VerString + INTTOSTR (VerValue^.dwFileVersionLS SHR 16) + '.';
0409: END;
0410: VerString := VerString + INTTOSTR (VerValue^.dwFileVersionLS AND $FFFF);
0411: FreeMem (VerInfo, VerInfoSize);
0412: FNopm_GetBuildVersion := VerString;
0413: END;
0414:
0415:
0416:
0417: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0418: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0419: FUNCTION FNopm_ColorToRGB (CurColor : TColor) : STRING;
0420: BEGIN
0421: IF (CurColor >= 0) THEN
0422: FNopm_ColorToRGB := INTTOHEX (GetRValue (CurColor), 2) + INTTOHEX (GetGValue (CurColor), 2) + INTTOHEX (GetBValue (CurColor), 2)
0423: ELSE
0424: FNopm_ColorToRGB := opmC_NullColor_HexString;
0425: END;
0426:
0427:
0428:
0429: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0430: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0431: FUNCTION FNopm_ColorToDecColor (CurColor : TColor) : LONGINT;
0432: BEGIN
0433: IF (CurColor >= 0) THEN
0434: FNopm_ColorToDecColor := STRTOINT ('$00' + INTTOHEX (GetBValue (CurColor), 2) + INTTOHEX (GetGValue (CurColor), 2) + INTTOHEX (GetRValue (CurColor), 2))
0435: ELSE
0436: FNopm_ColorToDecColor := STRTOINT ('$00' + opmC_NullColor_HexString);
0437: END;
0438:
0439:
0440:
0441: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0442: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0443: FUNCTION FNopm_DecColorToColor (DecColor : LONGINT) : TColor;
0444: BEGIN
0445: FNopm_DecColorToColor := STRINGTOCOLOR ('$' + INTTOHEX (DecColor, 8));
0446: END;
0447:
0448:
0449:
0450: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0451: CurColor is NOT a TColor constant (like clWindow).
0452: If using a TColor constant, it must be passed using a ColorToRGB function.
0453: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0454: FUNCTION FNopm_ComplementaryColor (CurColor : LONGINT) : TColor;
0455: BEGIN
0456: IF (CurColor >= 0) THEN
0457: FNopm_ComplementaryColor := RGB ((255 - GetRValue (CurColor)), (255 - GetGValue (CurColor)), (255 - GetBValue (CurColor)))
0458: ELSE
0459: FNopm_ComplementaryColor := STRTOINT ('$00' + opmC_CompNullColor_HexString);
0460: END;
0461:
0462:
0463:
0464: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0465: CurColor is NOT a TColor constant (like clWindow).
0466: If using a TColor constant, it must be passed using a ColorToRGB function.
0467: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0468: FUNCTION FNopm_HighlightColor (CurColor : LONGINT) : TColor;
0469: VAR
0470: RPart, GPart, BPart : LONGINT;
0471: BEGIN
0472: IF (CurColor >= 0) THEN
0473: BEGIN
0474: RPart := (GetRValue (CurColor) + opmC_ColorHighOffest);
0475: IF (RPart > 255) THEN RPart := (RPart - (opmC_ColorHighOffest * 2));
0476: GPart := (GetGValue (CurColor) + opmC_ColorHighOffest);
0477: IF (GPart > 255) THEN GPart := (GPart - (opmC_ColorHighOffest * 2));
0478: BPart := (GetBValue (CurColor) + opmC_ColorHighOffest);
0479: IF (BPart > 255) THEN BPart := (BPart - (opmC_ColorHighOffest * 2));
0480: FNopm_HighlightColor := RGB (BPart, GPart, RPart);
0481: END
0482: ELSE
0483: FNopm_HighlightColor := STRTOINT ('$00' + opmC_CompNullColor_HexString);
0484: END;
0485:
0486:
0487:
0488: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0489: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0490: FUNCTION FNopm_StripHTML (SourceHTML : STRING) : STRING;
0491: VAR
0492: TargetText : STRING;
0493: SourcePos : WORD;
0494: InsideTag : BOOLEAN;
0495: BEGIN
0496: TargetText := '';
0497: InsideTag := FALSE;
0498: FOR SourcePos := 1 TO LENGTH (SourceHTML) DO
0499: BEGIN
0500: IF ((BYTETYPE (SourceHTML, SourcePos) = mbSingleByte) AND (SourceHTML[SourcePos] = '<')) THEN
0501: InsideTag := TRUE
0502: ELSE IF ((BYTETYPE (SourceHTML, SourcePos) = mbSingleByte) AND (SourceHTML[SourcePos] = '>')) THEN
0503: InsideTag := FALSE
0504: ELSE IF (InsideTag = FALSE) THEN
0505: TargetText := TargetText + SourceHTML[SourcePos];
0506: END;
0507: FNopm_StripHTML := TargetText;
0508: END;
0509:
0510:
0511:
0512: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0513: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0514: FUNCTION FNopm_StringToDate (DateStr : STRING) : TDATETIME;
0515: VAR
0516: Y, M, D, H, N : WORD;
0517: BEGIN
0518: IF (LENGTH (DateStr) > 15) THEN
0519: BEGIN
0520: TRY
0521: Y := STRTOINT (DateStr[1] + DateStr[2] + DateStr[3] + DateStr[4]);
0522: M := STRTOINT (DateStr[6] + DateStr[7]);
0523: D := STRTOINT (DateStr[9] + DateStr[10]);
0524: H := STRTOINT (DateStr[12] + DateStr[13]);
0525: N := STRTOINT (DateStr[15] + DateStr[16]);
0526: FNopm_StringToDate := ENCODEDATETIME (Y, M, D, H, N, 0, 0);
0527: EXCEPT
0528: FNopm_StringToDate := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0);
0529: END;
0530: END
0531: ELSE FNopm_StringToDate := opmG_Fallback_DateTime;
0532: END;
0533:
0534:
0535: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0536: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0537: FUNCTION FNopm_DateToString (DateDate : TDATETIME) : STRING;
0538: VAR
0539: DateString : STRING;
0540: BEGIN
0541: DATETIMETOSTRING (DateString, 'yyyy-mm-dd hh:nn:ss', DateDate);
0542: FNopm_DateToString := DateString;
0543: END;
0544:
0545:
0546:
0547:
0548:
0549: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0550: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0551: FUNCTION FNopm_IsAppRunning (AppTitle : STRING) : BOOLEAN;
0552: VAR
0553: WindowHandle: HWND;
0554: WindowTitle: ARRAY [0..255] OF CHAR;
0555: BEGIN
0556: FNopm_IsAppRunning := FALSE;
0557: WindowHandle := GetWindow (Application.Handle, GW_HWNDFIRST);
0558: WHILE (WindowHandle > 0) DO
0559: BEGIN
0560: FillChar (WindowTitle, LENGTH (WindowTitle), #0);
0561: GetWindowText (WindowHandle, WindowTitle, LENGTH (WindowTitle) - 1);
0562: IF (ANSIPOS (ANSIUPPERCASE (AppTitle), ANSIUPPERCASE (STRING (WindowTitle))) > 0) THEN
0563: BEGIN
0564: FNopm_IsAppRunning := TRUE;
0565: BREAK;
0566: END
0567: ELSE WindowHandle := GetWindow (WindowHandle, GW_HWNDNEXT);
0568: END;
0569: END;
0570:
0571:
0572:
0573: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0574: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0575: FUNCTION FNopm_StringFromResource (ResName : PCHAR) : STRING;
0576: VAR
0577: ResStream : TResourceStream;
0578: ResCount : LONGINT;
0579: DataString : ARRAY [0..1024] OF CHAR;
0580: FinalString : STRING;
0581: BEGIN
0582: FinalString := '';
0583: ResStream := NIL;
0584: TRY
0585: ResStream := TResourceStream.Create (HINSTANCE, ResName, RT_RCDATA);
0586: REPEAT
0587: ResCount := ResStream.Read (DataString, SIZEOF (DataString));
0588: FinalString := FinalString + COPY (DataString, 1, ResCount);
0589: UNTIL (ResCount < 1);
0590: FINALLY
0591: ResStream.Free;
0592: END;
0593: FNopm_StringFromResource := FinalString;
0594: END;
0595:
0596:
0597:
0598: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0599: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0600: FUNCTION FNopm_GetMemoryLoad : LONGINT;
0601: VAR
0602: MemStat : TMemoryStatus;
0603: BEGIN
0604: MemStat.dwLength := SIZEOF (MemStat);
0605: GlobalMemoryStatus (MemStat);
0606: FNopm_GetMemoryLoad := MemStat.dwMemoryLoad;
0607: END;
0608:
0609:
0610:
0611:
0612:
0613: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0614: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0615: FUNCTION FNopm_CheckLanguage (LangISOID : STRING) : BOOLEAN;
0616: VAR
0617: LangList : TStringList;
0618: BEGIN
0619: LangList := TStringList.Create;
0620: TRY
DefaultInstance.GetListOfLanguages ('default', LangList);
FNopm_CheckLanguage := (LangList.IndexOf (LangISOID) >= 0);
FINALLY
LangList.Free;
0621: END;
0622: END;
0623:
0624:
0625:
0626: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0627: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0628: PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet);
0629: VAR
0630: CurForm : LONGINT;
0631: BEGIN
0632: FOR CurForm := 0 TO (Screen.FormCount - 1) DO
0633: BEGIN
0634: Screen.Forms[CurForm].Font.Name := FontName;
0635: Screen.Forms[CurForm].Font.Size := FontSize;
0636: Screen.Forms[CurForm].Font.Charset := FontCharset;
0637: END;
0638: END;
0639:
0640:
0641:
0642: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0643: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0644: FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0645: VAR
0646: PreTaxPrice : CURRENCY;
0647: PostTaxPrice : CURRENCY;
0648: BEGIN
0649: PostTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0650: PreTaxPrice := PostTaxPrice / (1 + (TaxRate / 100));
0651: FNopm_BeforeTaxPrice := CURRTOSTR (PreTaxPrice);
0652: END;
0653:
0654:
0655:
0656: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0657: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0658: FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0659: VAR
0660: PreTaxPrice : CURRENCY;
0661: PostTaxPrice : CURRENCY;
0662: BEGIN
0663: PreTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0664: PostTaxPrice := PreTaxPrice * (1 + (TaxRate / 100));
0665: FNopm_AfterTaxPrice := CURRTOSTR (PostTaxPrice);
0666: END;
0667:
0668:
0669:
0670: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0671: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0672: FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING;
0673: BEGIN
0674: IF (NumValue > 0) THEN
0675: FNopm_NumToYesNo := _('Yes')
0676: ELSE
0677: FNopm_NumToYesNo := _('No');
0678: END;
0679:
0680:
0681: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0682: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0683: FUNCTION opm_FNMD5 (Str2Hash : STRING) : STRING;
0684: VAR
0685: MD5Hasher : TIdHashMessageDigest5;
0686: BEGIN
0687: MD5Hasher := TIdHashMessageDigest5.Create;
0688: opm_FNMD5 := MD5Hasher.AsHex (MD5Hasher.HashValue (Str2Hash));
0689: FreeAndNIL (MD5Hasher);
0690: END;
0691:
0692:
0693:
0694: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0695: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0696: FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER;
0697: VAR
0698: PartCount : WORD;
0699: VNS1, VNS2 : ARRAY [1..4] OF LONGINT;
0700: DotPos1, DotPos2 : WORD;
0701: VersionSum1, VersionSum2 : LONGINT;
0702: BEGIN
0703: VersionString1 := TRIM (VersionString1) + '.';
0704: VersionString2 := TRIM (VersionString2) + '.';
0705: FOR PartCount := 1 TO 4 DO
0706: BEGIN
0707: DotPos1 := ANSIPOS ('.', VersionString1);
0708: DotPos2 := ANSIPOS ('.', VersionString2);
0709: VNS1[PartCount] := STRTOINT (COPY (VersionString1, 1, (DotPos1 - 1)));
0710: VNS2[PartCount] := STRTOINT (COPY (VersionString2, 1, (DotPos2 - 1)));
0711: DELETE (VersionString1, 1, DotPos1);
0712: DELETE (VersionString2, 1, DotPos2);
0713: END;
0714: VersionSum1 := (VNS1[1] * 100000) + (VNS1[2] * 10000) + (VNS1[3] * 1000) + VNS1[4];
0715: VersionSum2 := (VNS2[1] * 100000) + (VNS2[2] * 10000) + (VNS2[3] * 1000) + VNS2[4];
0716: IF (VersionSum1 > VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsNewer
0717: ELSE IF (VersionSum1 < VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsOlder
0718: ELSE FNopm_CompareVersions := opmC_VersionIsEqual;
0719: END;
0720:
0721:
0722:
0723:
0724: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0725: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0726: FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING;
0727: VAR
0728: TmpStr : STRING;
0729: BEGIN
0730: TmpStr := ANSIREPLACESTR (ExtractFilePath (ANSIREPLACESTR (StrFullPath, '/', '\')), '\', '/');
0731: IF (COPY (TmpStr, LENGTH (TmpStr), 1) = '/') THEN
0732: BEGIN
0733: IF (LeaveTrailing = FALSE) THEN TmpStr := COPY (TmpStr, 1, (LENGTH (TmpStr) - 1));
0734: END
0735: ELSE
0736: BEGIN
0737: IF (LeaveTrailing = TRUE) THEN TmpStr := TmpStr + '/';
0738: END;
0739: FNopm_ExtractFilePath := TmpStr;
0740: END;
0741:
0742:
0743:
0744:
0745: INITIALIZATION
0746:
0747: opmG_Fallback_DateTime := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0);
0748: opmG_ExeBuildVersion := FNopm_GetBuildVersion (FALSE);
0749: opmG_PlatformVersion := FNopm_GetWindowsVersion;
0750: opmG_FullUserAgent := opmC_UserAgent + ' (' + opmG_PlatformVersion + ')';
0751:
0752: end.
