{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% osCommerce Product Manager for Windows (oscpmwin). Copyright ©2003,2004,2005 by Mario A. Valdez-Ramirez. You can contact Mario A. Valdez-Ramirez by email at mario@mariovaldez.org or paper mail at Olmos 809, San Nicolas, NL. 66495, Mexico. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} unit dataman; interface USES SysUtils, Graphics, Classes; CONST opmC_ValIsInteger = 1; opmC_ValIsCurrency = 2; opmC_ValIsNumOp = 3; opmC_ValIsIntegerEmpty = 4; opmC_ValIsCurrencyEmpty = 5; opmC_Valid_IntChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-']; opmC_Valid_RealChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-', '.']; opmC_Valid_NumOpChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '+', '-', '.', '%']; opmC_Valid_UploadChars = ['0'..'9', 'A'..'Z', 'a'..'z', '.', '_']; opmC_Valid_HexChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', 'A', 'B', 'C', 'D', 'E', 'F']; opmC_Valid_HostChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-']; opmC_Fallback_Year = 1990; opmC_Fallback_Month = 1; opmC_Fallback_Day = 1; opmC_Fallback_Hour = 12; opmC_Fallback_Minute = 0; opmC_NullColor_HexString = '000000'; opmC_CompNullColor_HexString = 'FFFFFF'; opmC_ColorHighOffest = 25; opmC_VersionIsOlder = -1; opmC_VersionIsEqual = 0; opmC_VersionIsNewer = 1; FUNCTION FNopm_CleanUploadName (Str2Clean : STRING) : STRING; FUNCTION FNopm_CleanHostName (Str2Clean : STRING) : STRING; FUNCTION FNopm_CleanSQLString (Str2Clean : STRING; Searching : BOOLEAN) : STRING; FUNCTION FNopm_NoCRLF (Str2Clean : STRING) : STRING; FUNCTION FNopm_CleanNumber (SourceValue : STRING; ValueType : INTEGER) : STRING; FUNCTION FNopm_StrToInt (SourceValue : STRING) : LONGINT; FUNCTION FNopm_CleanHexNumber (SourceValue : STRING; NumberLen : WORD) : STRING; FUNCTION FNopm_CleanString (Str2Clean : STRING) : STRING; FUNCTION FNopm_GetTemporaryPath : STRING; FUNCTION FNopm_RunExternalApp (ExeFileName, ExeParams, RunDirectory : STRING; WaitApp, ShowApp : BOOLEAN; WaitForIdle : LONGINT): CARDINAL; PROCEDURE PRopm_StopExternalApp (AppHandle : CARDINAL); PROCEDURE PRopm_StopExternalAppByName (AppTitle : STRING); FUNCTION FNopm_GetWindowsVersion : STRING; FUNCTION FNopm_GetBuildVersion (FullString : BOOLEAN) : STRING; FUNCTION FNopm_ColorToRGB (CurColor : TColor) : STRING; FUNCTION FNopm_ColorToDecColor (CurColor : TColor) : LONGINT; FUNCTION FNopm_DecColorToColor (DecColor : LONGINT) : TColor; FUNCTION FNopm_ComplementaryColor (CurColor : LONGINT) : TColor; FUNCTION FNopm_HighlightColor (CurColor : LONGINT) : TColor; FUNCTION FNopm_StripHTML (SourceHTML : STRING) : STRING; FUNCTION FNopm_StringToDate (DateStr : STRING) : TDATETIME; FUNCTION FNopm_DateToString (DateDate : TDATETIME) : STRING; FUNCTION FNopm_IsAppRunning (AppTitle : STRING) : BOOLEAN; FUNCTION FNopm_StringFromResource (ResName : PCHAR) : STRING; FUNCTION FNopm_GetMemoryLoad : LONGINT; FUNCTION FNopm_CheckLanguage (LangISOID : STRING) : BOOLEAN; PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet); FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING; FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING; FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING; FUNCTION opm_FNMD5 (Str2Hash : STRING) : STRING; FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER; FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING; VAR opmG_Fallback_DateTime : TDATETIME; opmG_ExeBuildVersion : STRING; opmG_PlatformVersion : STRING; implementation USES Windows, ShellApi, Messages, Forms, DateUtils, oscpmdata, gnugettext, IdHashMessageDigest, StrUtils; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanUploadName (Str2Clean : STRING) : STRING; VAR TmpStr : STRING; StrCount : WORD; BEGIN TmpStr := ''; Str2Clean := TRIM (Str2Clean); Str2Clean := ANSIREPLACESTR (Str2Clean, ' ', '_'); Str2Clean := ANSIREPLACESTR (Str2Clean, '-', '_'); FOR StrCount := 1 TO LENGTH (Str2Clean) DO IF (Str2Clean[StrCount] IN opmC_Valid_UploadChars) THEN TmpStr := TmpStr + Str2Clean[StrCount]; FNopm_CleanUploadName := TmpStr; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanHostName (Str2Clean : STRING) : STRING; VAR TmpStr : STRING; StrCount : WORD; BEGIN TmpStr := ''; FOR StrCount := 1 TO LENGTH (Str2Clean) DO IF (Str2Clean[StrCount] IN opmC_Valid_HostChars) THEN TmpStr := TmpStr + Str2Clean[StrCount]; FNopm_CleanHostName := TmpStr; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanSQLString (Str2Clean : STRING; Searching : BOOLEAN) : STRING; BEGIN Str2Clean := ANSIREPLACESTR (Str2Clean, '--', '-'); Str2Clean := ANSIREPLACESTR (Str2Clean, '\', '\\'); Str2Clean := ANSIREPLACESTR (Str2Clean, '"', '\"'); Str2Clean := ANSIREPLACESTR (Str2Clean, '''', '\'''); Str2Clean := ANSIREPLACESTR (Str2Clean, #13, '\r'); Str2Clean := ANSIREPLACESTR (Str2Clean, #10, '\n'); Str2Clean := ANSIREPLACESTR (Str2Clean, #26, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #8, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #9, ' '); IF (Searching = TRUE) THEN BEGIN Str2Clean := ANSIREPLACESTR (Str2Clean, '%', '\%'); Str2Clean := ANSIREPLACESTR (Str2Clean, '_', '\_'); END; FNopm_CleanSQLString := TRIM (Str2Clean); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_NoCRLF (Str2Clean : STRING) : STRING; BEGIN Str2Clean := ANSIREPLACESTR (Str2Clean, #13, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #10, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #26, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #8, ''); Str2Clean := ANSIREPLACESTR (Str2Clean, #9, ''); FNopm_NoCRLF := TRIM (Str2Clean); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanString (Str2Clean : STRING) : STRING; VAR TmpStr : STRING; BEGIN REPEAT TmpStr := Str2Clean; Str2Clean := ANSIREPLACESTR (Str2Clean, ' ', ' '); UNTIL (TmpStr = Str2Clean); Str2Clean := ANSIREPLACESTR (Str2Clean, #9, ''); FNopm_CleanString := TRIM (Str2Clean); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanNumber (SourceValue : STRING; ValueType : INTEGER) : STRING; VAR CurrChar : WORD; TargetStr : STRING; BEGIN TargetStr := ''; SourceValue := TRIM (SourceValue); IF ((SourceValue = '') AND ((ValueType = opmC_ValIsCurrencyEmpty) OR (ValueType = opmC_ValIsIntegerEmpty))) THEN TargetStr := '' ELSE CASE ValueType OF opmC_ValIsInteger, opmC_ValIsIntegerEmpty: BEGIN FOR CurrChar := 1 TO LENGTH (SourceValue) DO IF (SourceValue[CurrChar] IN opmC_Valid_IntChars) THEN TargetStr := TargetStr + SourceValue[CurrChar] ELSE BREAK; TRY TargetStr := INTTOSTR (STRTOINT (TargetStr)); EXCEPT TargetStr := '0'; END; END; opmC_ValIsCurrency, opmC_ValIsCurrencyEmpty: BEGIN FOR CurrChar := 1 TO LENGTH (SourceValue) DO IF (SourceValue[CurrChar] IN opmC_Valid_RealChars) THEN TargetStr := TargetStr + SourceValue[CurrChar]; TRY TargetStr := CURRTOSTRF (STRTOCURR (TargetStr), ffFixed, 2); EXCEPT TargetStr := '0.00'; END; END; opmC_ValIsNumOp: BEGIN FOR CurrChar := 1 TO LENGTH (SourceValue) DO IF (SourceValue[CurrChar] IN opmC_Valid_NumOpChars) THEN TargetStr := TargetStr + SourceValue[CurrChar]; END; END; FNopm_CleanNumber := TargetStr; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_StrToInt (SourceValue : STRING) : LONGINT; VAR CurrChar : WORD; TargetStr : STRING; TargetInt : LONGINT; BEGIN TargetStr := ''; SourceValue := TRIM (SourceValue); FOR CurrChar := 1 TO LENGTH (SourceValue) DO IF (SourceValue[CurrChar] IN opmC_Valid_IntChars) THEN TargetStr := TargetStr + SourceValue[CurrChar] ELSE BREAK; TRY TargetInt := STRTOINT (TargetStr); EXCEPT TargetInt := 0; END; FNopm_StrToInt := TargetInt; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CleanHexNumber (SourceValue : STRING; NumberLen : WORD) : STRING; VAR TmpStr : STRING; StrCount : WORD; BEGIN TmpStr := ''; SourceValue := ANSIUPPERCASE (SourceValue); FOR StrCount := 1 TO LENGTH (SourceValue) DO IF (SourceValue[StrCount] IN opmC_Valid_HexChars) THEN TmpStr := TmpStr + SourceValue[StrCount]; IF (LENGTH (TmpStr) >= NumberLen) THEN SourceValue := COPY (TmpStr, 1, NumberLen) ELSE SourceValue := STRINGOFCHAR ('0', NumberLen - LENGTH (TmpStr)) + TmpStr; FNopm_CleanHexNumber := SourceValue; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_GetTemporaryPath : STRING; VAR TmpDir : STRING; BufSize : DWORD; BEGIN SETLENGTH (TmpDir, MAX_PATH); BufSize := GetTempPath (MAX_PATH, PCHAR (TmpDir)); SETLENGTH (TmpDir, BufSize); FNopm_GetTemporaryPath := TmpDir; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_RunExternalApp (ExeFileName, ExeParams, RunDirectory : STRING; WaitApp, ShowApp : BOOLEAN; WaitForIdle : LONGINT): CARDINAL; VAR MsgInfo: TMsg; ExeInfo : TShellExecuteInfo; ExitCode : DWORD; BEGIN ExeInfo.cbSize := SIZEOF (ExeInfo); ExeInfo.fMask := (SEE_MASK_NOCLOSEPROCESS OR SEE_MASK_FLAG_NO_UI); ExeInfo.wnd := Application.Handle; ExeInfo.lpVerb := 'open'; ExeInfo.lpFile := PCHAR (ExeFileName); ExeInfo.lpParameters := PCHAR (ExeParams); ExeInfo.lpDirectory := PCHAR (RunDirectory); IF (ShowApp = FALSE) THEN ExeInfo.nShow := SW_HIDE { SW_SHOWMINNOACTIV ??? } ELSE ExeInfo.nShow := SW_SHOWNORMAL; { SW_SHOWDEFAULT ??? } IF (ShellExecuteEx (@ExeInfo) = TRUE) THEN BEGIN IF (WaitApp = TRUE) THEN BEGIN REPEAT WHILE (PeekMessage (MsgInfo, 0, 0, 0, PM_REMOVE) = TRUE) DO BEGIN IF (MsgInfo.Message = WM_QUIT) THEN Halt (MsgInfo.WParam); TranslateMessage (MsgInfo); DispatchMessage (MsgInfo); END; UNTIL (WaitForSingleObject (ExeInfo.hProcess, 50) <> WAIT_TIMEOUT); GetExitCodeProcess (ExeInfo.hProcess, ExitCode); CloseHandle (ExeInfo.hProcess); FNopm_RunExternalApp := ExitCode; END ELSE BEGIN IF (WaitForIdle > 0) THEN WaitForInputIdle (ExeInfo.hProcess, WaitForIdle); FNopm_RunExternalApp := ExeInfo.hProcess; END; END ELSE FNopm_RunExternalApp := 0; end; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_StopExternalApp (AppHandle : CARDINAL); BEGIN IF (AppHandle > 0) THEN IF (TerminateProcess (AppHandle, ExitCode) = TRUE) THEN CloseHandle (AppHandle); end; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_StopExternalAppByName (AppTitle : STRING); VAR WindowHandle: HWND; WindowTitle: ARRAY [0..255] of CHAR; ProcID : CARDINAL; ProcHandle : CARDINAL; BEGIN WindowHandle := GetWindow (Application.Handle, GW_HWNDFIRST); WHILE (WindowHandle > 0) DO BEGIN FillChar (WindowTitle, LENGTH (WindowTitle), #0); GetWindowText (WindowHandle, WindowTitle, LENGTH (WindowTitle) - 1); IF (ANSIPOS (ANSIUPPERCASE (AppTitle), ANSIUPPERCASE (STRING (WindowTitle))) > 0) THEN BEGIN GetWindowThreadProcessId (WindowHandle, @ProcID); ProcHandle := OpenProcess (PROCESS_TERMINATE, FALSE, ProcID); TerminateProcess (ProcHandle, 0); CloseHandle (ProcHandle); BREAK; END ELSE WindowHandle := GetWindow (WindowHandle, GW_HWNDNEXT); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_GetWindowsVersion : STRING; VAR VerInfo : OSVERSIONINFO; BEGIN VerInfo.dwOSVersionInfoSize := SIZEOF (OSVERSIONINFO); GetVersionEx (VerInfo); FNopm_GetWindowsVersion := 'Windows ' + INTTOSTR (VerInfo.dwMajorVersion) + '.' + INTTOSTR (VerInfo.dwMinorVersion) + ' build ' + INTTOSTR (VerInfo.dwBuildNumber) + ' ' + VerInfo.szCSDVersion; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_GetBuildVersion (FullString : BOOLEAN) : STRING; VAR VerInfoSize: DWORD; VerInfo: POINTER; VerValueSize: DWORD; VerValue: PVSFixedFileInfo; Dummy: DWORD; VerString : STRING; BEGIN VerString := ''; VerInfoSize := GetFileVersionInfoSize (PChar (Application.ExeName), Dummy); GetMem (VerInfo, VerInfoSize); GetFileVersionInfo (PChar (ParamStr (0)), 0, VerInfoSize, VerInfo); VerQueryValue (VerInfo, '\', Pointer (VerValue), VerValueSize); IF (FullString = TRUE) THEN BEGIN VerString := VerString + INTTOSTR (VerValue^.dwFileVersionMS SHR 16) + '.'; VerString := VerString + INTTOSTR (VerValue^.dwFileVersionMS AND $FFFF) + '.'; VerString := VerString + INTTOSTR (VerValue^.dwFileVersionLS SHR 16) + '.'; END; VerString := VerString + INTTOSTR (VerValue^.dwFileVersionLS AND $FFFF); FreeMem (VerInfo, VerInfoSize); FNopm_GetBuildVersion := VerString; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ColorToRGB (CurColor : TColor) : STRING; BEGIN IF (CurColor >= 0) THEN FNopm_ColorToRGB := INTTOHEX (GetRValue (CurColor), 2) + INTTOHEX (GetGValue (CurColor), 2) + INTTOHEX (GetBValue (CurColor), 2) ELSE FNopm_ColorToRGB := opmC_NullColor_HexString; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ColorToDecColor (CurColor : TColor) : LONGINT; BEGIN IF (CurColor >= 0) THEN FNopm_ColorToDecColor := STRTOINT ('$00' + INTTOHEX (GetBValue (CurColor), 2) + INTTOHEX (GetGValue (CurColor), 2) + INTTOHEX (GetRValue (CurColor), 2)) ELSE FNopm_ColorToDecColor := STRTOINT ('$00' + opmC_NullColor_HexString); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_DecColorToColor (DecColor : LONGINT) : TColor; BEGIN FNopm_DecColorToColor := STRINGTOCOLOR ('$' + INTTOHEX (DecColor, 8)); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CurColor is NOT a TColor constant (like clWindow). If using a TColor constant, it must be passed using a ColorToRGB function. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ComplementaryColor (CurColor : LONGINT) : TColor; BEGIN IF (CurColor >= 0) THEN FNopm_ComplementaryColor := RGB ((255 - GetRValue (CurColor)), (255 - GetGValue (CurColor)), (255 - GetBValue (CurColor))) ELSE FNopm_ComplementaryColor := STRTOINT ('$00' + opmC_CompNullColor_HexString); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CurColor is NOT a TColor constant (like clWindow). If using a TColor constant, it must be passed using a ColorToRGB function. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_HighlightColor (CurColor : LONGINT) : TColor; VAR RPart, GPart, BPart : LONGINT; BEGIN IF (CurColor >= 0) THEN BEGIN RPart := (GetRValue (CurColor) + opmC_ColorHighOffest); IF (RPart > 255) THEN RPart := (RPart - (opmC_ColorHighOffest * 2)); GPart := (GetGValue (CurColor) + opmC_ColorHighOffest); IF (GPart > 255) THEN GPart := (GPart - (opmC_ColorHighOffest * 2)); BPart := (GetBValue (CurColor) + opmC_ColorHighOffest); IF (BPart > 255) THEN BPart := (BPart - (opmC_ColorHighOffest * 2)); FNopm_HighlightColor := RGB (BPart, GPart, RPart); END ELSE FNopm_HighlightColor := STRTOINT ('$00' + opmC_CompNullColor_HexString); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_StripHTML (SourceHTML : STRING) : STRING; VAR TargetText : STRING; SourcePos : WORD; InsideTag : BOOLEAN; BEGIN TargetText := ''; InsideTag := FALSE; FOR SourcePos := 1 TO LENGTH (SourceHTML) DO BEGIN IF ((BYTETYPE (SourceHTML, SourcePos) = mbSingleByte) AND (SourceHTML[SourcePos] = '<')) THEN InsideTag := TRUE ELSE IF ((BYTETYPE (SourceHTML, SourcePos) = mbSingleByte) AND (SourceHTML[SourcePos] = '>')) THEN InsideTag := FALSE ELSE IF (InsideTag = FALSE) THEN TargetText := TargetText + SourceHTML[SourcePos]; END; FNopm_StripHTML := TargetText; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_StringToDate (DateStr : STRING) : TDATETIME; VAR Y, M, D, H, N : WORD; BEGIN IF (LENGTH (DateStr) > 15) THEN BEGIN TRY Y := STRTOINT (DateStr[1] + DateStr[2] + DateStr[3] + DateStr[4]); M := STRTOINT (DateStr[6] + DateStr[7]); D := STRTOINT (DateStr[9] + DateStr[10]); H := STRTOINT (DateStr[12] + DateStr[13]); N := STRTOINT (DateStr[15] + DateStr[16]); FNopm_StringToDate := ENCODEDATETIME (Y, M, D, H, N, 0, 0); EXCEPT FNopm_StringToDate := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0); END; END ELSE FNopm_StringToDate := opmG_Fallback_DateTime; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_DateToString (DateDate : TDATETIME) : STRING; VAR DateString : STRING; BEGIN DATETIMETOSTRING (DateString, 'yyyy-mm-dd hh:nn:ss', DateDate); FNopm_DateToString := DateString; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_IsAppRunning (AppTitle : STRING) : BOOLEAN; VAR WindowHandle: HWND; WindowTitle: ARRAY [0..255] OF CHAR; BEGIN FNopm_IsAppRunning := FALSE; WindowHandle := GetWindow (Application.Handle, GW_HWNDFIRST); WHILE (WindowHandle > 0) DO BEGIN FillChar (WindowTitle, LENGTH (WindowTitle), #0); GetWindowText (WindowHandle, WindowTitle, LENGTH (WindowTitle) - 1); IF (ANSIPOS (ANSIUPPERCASE (AppTitle), ANSIUPPERCASE (STRING (WindowTitle))) > 0) THEN BEGIN FNopm_IsAppRunning := TRUE; BREAK; END ELSE WindowHandle := GetWindow (WindowHandle, GW_HWNDNEXT); END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_StringFromResource (ResName : PCHAR) : STRING; VAR ResStream : TResourceStream; ResCount : LONGINT; DataString : ARRAY [0..1024] OF CHAR; FinalString : STRING; BEGIN FinalString := ''; ResStream := NIL; TRY ResStream := TResourceStream.Create (HINSTANCE, ResName, RT_RCDATA); REPEAT ResCount := ResStream.Read (DataString, SIZEOF (DataString)); FinalString := FinalString + COPY (DataString, 1, ResCount); UNTIL (ResCount < 1); FINALLY ResStream.Free; END; FNopm_StringFromResource := FinalString; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_GetMemoryLoad : LONGINT; VAR MemStat : TMemoryStatus; BEGIN MemStat.dwLength := SIZEOF (MemStat); GlobalMemoryStatus (MemStat); FNopm_GetMemoryLoad := MemStat.dwMemoryLoad; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CheckLanguage (LangISOID : STRING) : BOOLEAN; VAR LangList : TStringList; BEGIN LangList := TStringList.Create; TRY DefaultInstance.GetListOfLanguages ('default', LangList); FNopm_CheckLanguage := (LangList.IndexOf (LangISOID) >= 0); FINALLY LangList.Free; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet); VAR CurForm : LONGINT; BEGIN FOR CurForm := 0 TO (Screen.FormCount - 1) DO BEGIN Screen.Forms[CurForm].Font.Name := FontName; Screen.Forms[CurForm].Font.Size := FontSize; Screen.Forms[CurForm].Font.Charset := FontCharset; END; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING; VAR PreTaxPrice : CURRENCY; PostTaxPrice : CURRENCY; BEGIN PostTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency))); PreTaxPrice := PostTaxPrice / (1 + (TaxRate / 100)); FNopm_BeforeTaxPrice := CURRTOSTR (PreTaxPrice); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING; VAR PreTaxPrice : CURRENCY; PostTaxPrice : CURRENCY; BEGIN PreTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency))); PostTaxPrice := PreTaxPrice * (1 + (TaxRate / 100)); FNopm_AfterTaxPrice := CURRTOSTR (PostTaxPrice); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING; BEGIN IF (NumValue > 0) THEN FNopm_NumToYesNo := _('Yes') ELSE FNopm_NumToYesNo := _('No'); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION opm_FNMD5 (Str2Hash : STRING) : STRING; VAR MD5Hasher : TIdHashMessageDigest5; BEGIN MD5Hasher := TIdHashMessageDigest5.Create; opm_FNMD5 := MD5Hasher.AsHex (MD5Hasher.HashValue (Str2Hash)); FreeAndNIL (MD5Hasher); END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER; VAR PartCount : WORD; VNS1, VNS2 : ARRAY [1..4] OF LONGINT; DotPos1, DotPos2 : WORD; VersionSum1, VersionSum2 : LONGINT; BEGIN VersionString1 := TRIM (VersionString1) + '.'; VersionString2 := TRIM (VersionString2) + '.'; FOR PartCount := 1 TO 4 DO BEGIN DotPos1 := ANSIPOS ('.', VersionString1); DotPos2 := ANSIPOS ('.', VersionString2); VNS1[PartCount] := STRTOINT (COPY (VersionString1, 1, (DotPos1 - 1))); VNS2[PartCount] := STRTOINT (COPY (VersionString2, 1, (DotPos2 - 1))); DELETE (VersionString1, 1, DotPos1); DELETE (VersionString2, 1, DotPos2); END; VersionSum1 := (VNS1[1] * 100000) + (VNS1[2] * 10000) + (VNS1[3] * 1000) + VNS1[4]; VersionSum2 := (VNS2[1] * 100000) + (VNS2[2] * 10000) + (VNS2[3] * 1000) + VNS2[4]; IF (VersionSum1 > VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsNewer ELSE IF (VersionSum1 < VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsOlder ELSE FNopm_CompareVersions := opmC_VersionIsEqual; END; {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%} FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING; VAR TmpStr : STRING; BEGIN TmpStr := ANSIREPLACESTR (ExtractFilePath (ANSIREPLACESTR (StrFullPath, '/', '\')), '\', '/'); IF (COPY (TmpStr, LENGTH (TmpStr), 1) = '/') THEN BEGIN IF (LeaveTrailing = FALSE) THEN TmpStr := COPY (TmpStr, 1, (LENGTH (TmpStr) - 1)); END ELSE BEGIN IF (LeaveTrailing = TRUE) THEN TmpStr := TmpStr + '/'; END; FNopm_ExtractFilePath := TmpStr; END; INITIALIZATION opmG_Fallback_DateTime := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0); opmG_ExeBuildVersion := FNopm_GetBuildVersion (FALSE); opmG_PlatformVersion := FNopm_GetWindowsVersion; opmG_FullUserAgent := opmC_UserAgent + ' (' + opmG_PlatformVersion + ')'; end.