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