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