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