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