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