Source code of file oscpmwin_v0.4.1.816/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:     TRY
0569:       LangList := TStringList.Create;
0570:       TRY
0571:         DefaultInstance.GetListOfLanguages ('default', LangList);
0572:         FNopm_CheckLanguage := (LangList.IndexOf (LangISOID) >= 0);
0573:       FINALLY
0574:         LangList.Free;
0575:       END;
0576:     EXCEPT
0577:       FNopm_CheckLanguage := FALSE;
0578:     END;
0579:   END;
0580:   
0581:   
0582:   
0583:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0584:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0585:   PROCEDURE PRopm_Change_AppFont (FontName : STRING; FontSize : LONGINT; FontCharset : TFontCharSet);
0586:   VAR
0587:     CurForm : LONGINT;
0588:   BEGIN
0589:     FOR CurForm := 0 TO (Screen.FormCount - 1) DO
0590:       BEGIN
0591:         Screen.Forms[CurForm].Font.Name := FontName;
0592:         Screen.Forms[CurForm].Font.Size := FontSize;
0593:         Screen.Forms[CurForm].Font.Charset := FontCharset;
0594:       END;
0595:   END;
0596:   
0597:   
0598:   
0599:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0600:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0601:   FUNCTION FNopm_BeforeTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0602:   VAR
0603:     PreTaxPrice : CURRENCY;
0604:     PostTaxPrice : CURRENCY;
0605:   BEGIN
0606:     PostTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0607:     PreTaxPrice := PostTaxPrice / (1 + (TaxRate / 100));
0608:     FNopm_BeforeTaxPrice := CURRTOSTR (PreTaxPrice);
0609:   END;
0610:   
0611:   
0612:   
0613:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0614:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0615:   FUNCTION FNopm_AfterTaxPrice (Price : STRING; TaxRate : REAL) : STRING;
0616:   VAR
0617:     PreTaxPrice : CURRENCY;
0618:     PostTaxPrice : CURRENCY;
0619:   BEGIN
0620:     PreTaxPrice := ABS (STRTOCURR (FNopm_CleanNumber (Price, opmC_ValIsCurrency)));
0621:     PostTaxPrice := PreTaxPrice * (1 + (TaxRate / 100));
0622:     FNopm_AfterTaxPrice := CURRTOSTR (PostTaxPrice);
0623:   END;
0624:   
0625:   
0626:   
0627:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0628:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0629:   FUNCTION FNopm_NumToYesNo (NumValue : LONGINT) : STRING;
0630:   BEGIN
0631:     IF (NumValue > 0) THEN
0632:       FNopm_NumToYesNo := _('Yes')
0633:     ELSE
0634:       FNopm_NumToYesNo := _('No');
0635:   END;
0636:   
0637:   
0638:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0639:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0640:   FUNCTION FNopm_MD5 (Str2Hash : STRING) : STRING;
0641:   VAR
0642:     MD5Hasher : TIdHashMessageDigest5;
0643:   BEGIN
0644:     MD5Hasher := TIdHashMessageDigest5.Create;
0645:     FNopm_MD5 := MD5Hasher.AsHex (MD5Hasher.HashValue (Str2Hash));
0646:     FreeAndNIL (MD5Hasher);
0647:   END;
0648:   
0649:   
0650:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0651:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0652:   FUNCTION FNopm_Base64_Encode (VAR Str2Encode : STRING) : STRING;
0653:   VAR
0654:     B64Encoder : TIdEncoderMIME;
0655:   BEGIN
0656:     FNopm_Base64_Encode := '';
0657:     TRY
0658:       B64Encoder := TIdEncoderMIME.Create (NIL);
0659:       TRY
0660:         FNopm_Base64_Encode := B64Encoder.EncodeString (Str2Encode);
0661:       FINALLY
0662:         FreeAndNIL (B64Encoder);
0663:       END;
0664:     EXCEPT
0665:       FNopm_Base64_Encode := '';
0666:     END;
0667:   END;
0668:   
0669:   
0670:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0671:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0672:   FUNCTION FNopm_Base64_Decode (VAR Str2Decode : STRING) : STRING;
0673:   VAR
0674:     B64Decoder : TIdDecoderMIME;
0675:   BEGIN
0676:     FNopm_Base64_Decode := '';
0677:     TRY
0678:       B64Decoder := TIdDecoderMIME.Create (NIL);
0679:       TRY
0680:         FNopm_Base64_Decode := B64Decoder.DecodeString (Str2Decode);
0681:       FINALLY
0682:         FreeAndNIL (B64Decoder);
0683:       END;
0684:     EXCEPT
0685:       FNopm_Base64_Decode := '';
0686:     END;
0687:   END;
0688:   
0689:   
0690:   
0691:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0692:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0693:   FUNCTION FNopm_Deflate (VAR Str2Encode : STRING) : STRING;
0694:   VAR
0695:     Deflater : TIdCompressionIntercept;
0696:     DefBuffer : TStringStream;
0697:   BEGIN
0698:     FNopm_Deflate := '';
0699:     TRY
0700:       Deflater := TIdCompressionIntercept.Create (NIL);
0701:       Deflater.CompressionLevel := 2;
0702:       DefBuffer := TStringStream.Create (Str2Encode);
0703:       TRY
0704:         Deflater.Send (DefBuffer);
0705:         FNopm_Deflate := DefBuffer.DataString;
0706:       FINALLY
0707:         FreeAndNIL (Deflater);
0708:         FreeAndNIL (DefBuffer);
0709:       END;
0710:     EXCEPT
0711:       FNopm_Deflate := '';
0712:     END;
0713:   END;
0714:   
0715:   
0716:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0717:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0718:   FUNCTION FNopm_Inflate (VAR Str2Decode : STRING) : STRING;
0719:   VAR
0720:     Inflater : TIdCompressionIntercept;
0721:     DefBuffer : TStringStream;
0722:   BEGIN
0723:     FNopm_Inflate := '';
0724:     TRY
0725:       Inflater := TIdCompressionIntercept.Create (NIL);
0726:       Inflater.CompressionLevel := 2;
0727:       DefBuffer := TStringStream.Create (Str2Decode);
0728:       TRY
0729:         Inflater.Receive (DefBuffer);
0730:         FNopm_Inflate := DefBuffer.DataString;
0731:       FINALLY
0732:         FreeAndNIL (Inflater);
0733:         FreeAndNIL (DefBuffer);
0734:       END;
0735:     EXCEPT
0736:       FNopm_Inflate := '';
0737:     END;
0738:   END;
0739:   
0740:   
0741:   
0742:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0743:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0744:   FUNCTION FNopm_CompareVersions (VersionString1, VersionString2 : STRING) : INTEGER;
0745:   VAR
0746:     PartCount : WORD;
0747:     VNS1, VNS2 : ARRAY [1..4] OF LONGINT;
0748:     DotPos1, DotPos2 : WORD;
0749:     VersionSum1, VersionSum2 : LONGINT;
0750:   BEGIN
0751:     VersionString1 := TRIM (VersionString1) + '.';
0752:     VersionString2 := TRIM (VersionString2) + '.';
0753:     FOR PartCount := 1 TO 4 DO
0754:       BEGIN
0755:         DotPos1 := ANSIPOS ('.', VersionString1);
0756:         DotPos2 := ANSIPOS ('.', VersionString2);
0757:         VNS1[PartCount] := STRTOINT (COPY (VersionString1, 1, (DotPos1 - 1)));
0758:         VNS2[PartCount] := STRTOINT (COPY (VersionString2, 1, (DotPos2 - 1)));
0759:         DELETE (VersionString1, 1, DotPos1);
0760:         DELETE (VersionString2, 1, DotPos2);
0761:       END;
0762:     VersionSum1 := (VNS1[1] * 100000) + (VNS1[2] * 10000) + (VNS1[3] * 1000) + VNS1[4];
0763:     VersionSum2 := (VNS2[1] * 100000) + (VNS2[2] * 10000) + (VNS2[3] * 1000) + VNS2[4];
0764:     IF (VersionSum1 > VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsNewer
0765:     ELSE IF (VersionSum1 < VersionSum2) THEN FNopm_CompareVersions := opmC_VersionIsOlder
0766:     ELSE FNopm_CompareVersions := opmC_VersionIsEqual;
0767:   END;
0768:   
0769:   
0770:   
0771:   
0772:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0773:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0774:   FUNCTION FNopm_ExtractFilePath (StrFullPath : STRING; LeaveTrailing : BOOLEAN) : STRING;
0775:   VAR
0776:     TmpStr : STRING;
0777:   BEGIN
0778:     TmpStr := ANSIREPLACESTR (ExtractFilePath (ANSIREPLACESTR (StrFullPath, '/', '\')), '\', '/');
0779:     IF (COPY (TmpStr, LENGTH (TmpStr), 1) = '/') THEN
0780:       BEGIN
0781:         IF (LeaveTrailing = FALSE) THEN TmpStr := COPY (TmpStr, 1, (LENGTH (TmpStr) - 1));
0782:       END
0783:     ELSE
0784:       BEGIN
0785:         IF (LeaveTrailing = TRUE) THEN TmpStr := TmpStr + '/';
0786:       END;
0787:     FNopm_ExtractFilePath := TmpStr;
0788:   END;
0789:   
0790:   
0791:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0792:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0793:   FUNCTION FNopm_FixURL (URLString : STRING) : STRING;
0794:   VAR
0795:     TmpProto : STRING;
0796:     ProtoPos : LONGINT;
0797:   BEGIN
0798:     URLString := TRIM (URLString);
0799:     ProtoPos := ANSIPOS ('://', URLString);
0800:     IF (ProtoPos = 0) THEN
0801:       URLString := opmC_Def_HTTPProtocol + '://' + URLString
0802:     ELSE
0803:       BEGIN
0804:         TmpProto := ANSIUPPERCASE (COPY (URLString, 1, (ProtoPos - 1)));
0805:         IF ((TmpProto <> 'HTTP') AND (TmpProto <> 'HTTPS')) THEN
0806:           URLString := opmC_Def_HTTPProtocol + '://' + COPY (URLString, (ProtoPos + 3), LENGTH (URLString));
0807:       END;
0808:     FNopm_FixURL := URLString;
0809:   END;
0810:   
0811:   
0812:   
0813:   INITIALIZATION
0814:   
0815:   opmG_Fallback_DateTime := ENCODEDATETIME (opmC_Fallback_Year, opmC_Fallback_Month, opmC_Fallback_Day, opmC_Fallback_Hour, opmC_Fallback_Minute, 0, 0);
0816:   opmG_ExeBuildVersion := FNopm_GetBuildVersion (FALSE);
0817:   opmG_PlatformVersion := FNopm_GetWindowsVersion;
0818:   opmG_FullUserAgent := opmC_UserAgent + ' (' + opmG_PlatformVersion + ')';
0819:   
0820:   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