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