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