Source code of file oscpmwin_v0.4.1.745/dataman.pas from the
osCommerce Product Manager for Windows.


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