Source code of file oscpmwin_v0.4.1.723/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: LangList := TStringList.Create;
0569: TRY
0570: DefaultInstance.GetListOfLanguages ('default', LangList);
0571: FNopm_CheckLanguage := (LangList.IndexOf (LangISOID) >= 0);
0572: FINALLY
0573: LangList.Free;
0574: END;
0575: END;
0576:
0577:
0578:
0579: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0580: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0581: PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet);
0582: VAR
0583: CurForm : LONGINT;
0584: BEGIN
0585: FOR CurForm := 0 TO (Screen.FormCount - 1) DO
0586: BEGIN
0587: Screen.Forms[CurForm].Font.Name := FontName;
0588: Screen.Forms[CurForm].Font.Size := FontSize;
0589: Screen.Forms[CurForm].Font.Charset := FontCharset;
0590: END;
0591: END;
0592:
0593:
0594:
0595: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0596: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0597: FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0598: VAR
0599: PreTaxPrice : CURRENCY;
0600: PostTaxPrice : CURRENCY;
0601: BEGIN
0602: PostTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0603: PreTaxPrice := PostTaxPrice / (1 + (TaxRate / 100));
0604: FNopm_BeforeTaxPrice := CURRTOSTR (PreTaxPrice);
0605: END;
0606:
0607:
0608:
0609: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0610: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0611: FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0612: VAR
0613: PreTaxPrice : CURRENCY;
0614: PostTaxPrice : CURRENCY;
0615: BEGIN
0616: PreTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0617: PostTaxPrice := PreTaxPrice * (1 + (TaxRate / 100));
0618: FNopm_AfterTaxPrice := CURRTOSTR (PostTaxPrice);
0619: END;
0620:
0621:
0622:
0623: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0624: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0625: FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING;
0626: BEGIN
0627: IF (NumValue > 0) THEN
0628: FNopm_NumToYesNo := _('Yes')
0629: ELSE
0630: FNopm_NumToYesNo := _('No');
0631: END;
0632:
0633:
0634: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0635: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0636: FUNCTION FNopm_MD5 (Str2Hash : STRING) : STRING;
0637: VAR
0638: MD5Hasher : TIdHashMessageDigest5;
0639: BEGIN
0640: MD5Hasher := TIdHashMessageDigest5.Create;
0641: FNopm_MD5 := MD5Hasher.AsHex (MD5Hasher.HashValue (Str2Hash));
0642: FreeAndNIL (MD5Hasher);
0643: END;
0644:
0645:
0646: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0647: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0648: FUNCTION FNopm_Base64_Encode (VAR Str2Encode : STRING) : STRING;
0649: VAR
0650: B64Encoder : TIdEncoderMIME;
0651: BEGIN
0652: FNopm_Base64_Encode := '';
0653: TRY
0654: B64Encoder := TIdEncoderMIME.Create (NIL);
0655: TRY
0656: FNopm_Base64_Encode := B64Encoder.EncodeString (Str2Encode);
0657: FINALLY
0658: FreeAndNIL (B64Encoder);
0659: END;
0660: EXCEPT
0661: FNopm_Base64_Encode := '';
0662: END;
0663: END;
0664:
0665:
0666: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0667: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0668: FUNCTION FNopm_Base64_Decode (VAR Str2Decode : STRING) : STRING;
0669: VAR
0670: B64Decoder : TIdDecoderMIME;
0671: BEGIN
0672: FNopm_Base64_Decode := '';
0673: TRY
0674: B64Decoder := TIdDecoderMIME.Create (NIL);
0675: TRY
0676: FNopm_Base64_Decode := B64Decoder.DecodeString (Str2Decode);
0677: FINALLY
0678: FreeAndNIL (B64Decoder);
0679: END;
0680: EXCEPT
0681: FNopm_Base64_Decode := '';
0682: END;
0683: END;
0684:
0685:
0686:
0687: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0688: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0689: FUNCTION FNopm_Deflate (VAR Str2Encode : STRING) : STRING;
0690: VAR
0691: Deflater : TIdCompressionIntercept;
0692: DefBuffer : TStringStream;
0693: BEGIN
0694: FNopm_Deflate := '';
0695: TRY
0696: Deflater := TIdCompressionIntercept.Create (NIL);
0697: Deflater.CompressionLevel := 2;
0698: DefBuffer := TStringStream.Create (Str2Encode);
0699: TRY
0700: Deflater.Send (DefBuffer);
0701: FNopm_Deflate := DefBuffer.DataString;
0702: FINALLY
0703: FreeAndNIL (Deflater);
0704: FreeAndNIL (DefBuffer);
0705: END;
0706: EXCEPT
0707: FNopm_Deflate := '';
0708: END;
0709: END;
0710:
0711:
0712: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0713: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0714: FUNCTION FNopm_Inflate (VAR Str2Decode : STRING) : STRING;
0715: VAR
0716: Inflater : TIdCompressionIntercept;
0717: DefBuffer : TStringStream;
0718: BEGIN
0719: FNopm_Inflate := '';
0720: TRY
0721: Inflater := TIdCompressionIntercept.Create (NIL);
0722: Inflater.CompressionLevel := 2;
0723: DefBuffer := TStringStream.Create (Str2Decode);
0724: TRY
0725: Inflater.Receive (DefBuffer);
0726: FNopm_Inflate := DefBuffer.DataString;
0727: FINALLY
0728: FreeAndNIL (Inflater);
0729: FreeAndNIL (DefBuffer);
0730: END;
0731: EXCEPT
0732: FNopm_Inflate := '';
0733: END;
0734: END;
0735:
0736:
0737:
0738: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0739: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0740: FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER;
0741: VAR
0742: PartCount : WORD;
0743: VNS1, VNS2 : ARRAY [1..4] OF LONGINT;
0744: DotPos1, DotPos2 : WORD;
0745: VersionSum1, VersionSum2 : LONGINT;
0746: BEGIN
0747: VersionString1 := TRIM (VersionString1) + '.';
0748: VersionString2 := TRIM (VersionString2) + '.';
0749: FOR PartCount := 1 TO 4 DO
0750: BEGIN
0751: DotPos1 := ANSIPOS ('.', VersionString1);
0752: DotPos2 := ANSIPOS ('.', VersionString2);
0753: VNS1[PartCount] := STRTOINT (COPY (VersionString1, 1, (DotPos1 - 1)));
0754: VNS2[PartCount] := STRTOINT (COPY (VersionString2, 1, (DotPos2 - 1)));
0755: DELETE (VersionString1, 1, DotPos1);
0756: DELETE (VersionString2, 1, DotPos2);
0757: END;
0758: VersionSum1 := (VNS1[1] * 100000) + (VNS1[2] * 10000) + (VNS1[3] * 1000) + VNS1[4];
0759: VersionSum2 := (VNS2[1] * 100000) + (VNS2[2] * 10000) + (VNS2[3] * 1000) + VNS2[4];
0760: IF (VersionSum1 > VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsNewer
0761: ELSE IF (VersionSum1 < VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsOlder
0762: ELSE FNopm_CompareVersions := opmC_VersionIsEqual;
0763: END;
0764:
0765:
0766:
0767:
0768: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0769: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0770: FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING;
0771: VAR
0772: TmpStr : STRING;
0773: BEGIN
0774: TmpStr := ANSIREPLACESTR (ExtractFilePath (ANSIREPLACESTR (StrFullPath, '/', '\')), '\', '/');
0775: IF (COPY (TmpStr, LENGTH (TmpStr), 1) = '/') THEN
0776: BEGIN
0777: IF (LeaveTrailing = FALSE) THEN TmpStr := COPY (TmpStr, 1, (LENGTH (TmpStr) - 1));
0778: END
0779: ELSE
0780: BEGIN
0781: IF (LeaveTrailing = TRUE) THEN TmpStr := TmpStr + '/';
0782: END;
0783: FNopm_ExtractFilePath := TmpStr;
0784: END;
0785:
0786:
0787: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0788: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0789: FUNCTION FNopm_FixURL (URLString : STRING) : STRING;
0790: VAR
0791: TmpProto : STRING;
0792: ProtoPos : LONGINT;
0793: BEGIN
0794: URLString := TRIM (URLString);
0795: ProtoPos := ANSIPOS ('://', URLString);
0796: IF (ProtoPos = 0) THEN
0797: URLString := opmC_Def_HTTPProtocol + '://' + URLString
0798: ELSE
0799: BEGIN
0800: TmpProto := ANSIUPPERCASE (COPY (URLString, 1, (ProtoPos - 1)));
0801: IF ((TmpProto <> 'HTTP') AND (TmpProto <> 'HTTPS')) THEN
0802: URLString := opmC_Def_HTTPProtocol + '://' + COPY (URLString, (ProtoPos + 3), LENGTH (URLString));
0803: END;
0804: FNopm_FixURL := URLString;
0805: END;
0806:
0807:
0808:
0809: INITIALIZATION
0810:
0811: opmG_Fallback_DateTime := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0);
0812: opmG_ExeBuildVersion := FNopm_GetBuildVersion (FALSE);
0813: opmG_PlatformVersion := FNopm_GetWindowsVersion;
0814: opmG_FullUserAgent := opmC_UserAgent + ' (' + opmG_PlatformVersion + ')';
0815:
0816: end.
