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