home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d56 / VKDBF.ZIP / VKDBFUtil.pas < prev   
Pascal/Delphi Source File  |  2002-03-15  |  10KB  |  341 lines
  1. unit VKDBFUtil;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, SysUtils, Dialogs, VKDBFMemMgr;
  7.  
  8. function GetTmpFileName: String;
  9. function GetTmpPath: String;
  10. function wildc(cpPattern, cpStr: pChar; iLenString: Integer; ManyChars, OneChar: Char): Boolean;
  11. function FileLock(Handle, Offset, NumberOfBytes: Integer): Boolean;
  12. function FileUnLock(Handle, Offset, NumberOfBytes: Integer): Boolean;
  13. procedure ReplBlanks(var Strg: string; R: Char = '0');
  14. procedure ReplSign(var Strg: string);
  15. procedure Int2Str(val: Integer; width: Integer; var s: ShortString);
  16. function DtoS(d: TDateTime): String;
  17. function TtoS(d: TDateTime): String;
  18. function DTtoS(d: TDateTime): String;
  19. procedure WriteBugFile(FileName: String; Str: String);
  20.  
  21. implementation
  22.  
  23. function wildc(cpPattern, cpStr: pChar; iLenString: Integer; ManyChars, OneChar: Char): Boolean;
  24. var
  25.   WasStar, ucRet: Boolean;
  26.   i: Integer;
  27.   iLenStr: Integer;
  28.   cpString: pChar;
  29. label
  30.   WhileRet;
  31.  
  32.   function SerchPattern(cpPatt: pChar; iLen: Integer): boolean;
  33.   var
  34.     ucRet: boolean;
  35.     i: Integer;
  36.   label
  37.     EndWhile, EndFOR;
  38.   begin
  39.     ucRet := true;
  40.     while ( iLenStr <> 0 ) do
  41.     begin
  42.       ucRet := TRUE;
  43.       for i:=0 to iLen-1 do
  44.       begin
  45.         if ( (cpPatt[i] <> OneChar) and ( cpString[i] <> cpPatt[i] ) ) then
  46.         begin
  47.           ucRet := FALSE;
  48.           if WasStar then
  49.             goto EndFOR
  50.           else
  51.             goto EndWhile;
  52.         end;
  53.         if iLenStr-i-1 < 0 then
  54.         begin
  55.           ucRet := FALSE;
  56.           goto EndWhile;
  57.         end;
  58.       end;
  59.       EndFOR:
  60.       if ucRet then
  61.       begin
  62.         Inc(cpString, iLen);
  63.         Dec(iLenStr, iLen);
  64.         goto EndWhile;
  65.       end;
  66.       Inc(cpString);
  67.       Dec(iLenStr);
  68.     end;
  69.     EndWhile:
  70.     Result := ucRet;
  71.   end;
  72.  
  73. begin
  74.   i := 0;
  75.   cpString := cpStr;
  76.   iLenStr := iLenString;
  77.   if iLenStr = 0 then begin
  78.     if cpPattern = ManyChars then begin
  79.       Result := true;
  80.       Exit;
  81.     end else begin
  82.       Result := false;
  83.       Exit;
  84.     end;
  85.   end;
  86.   WasStar := false;
  87.   while cpPattern[0] <> #0 do
  88.   begin
  89.     if ( cpPattern[0] = ManyChars ) then
  90.     begin
  91.       ucRet := SerchPattern(cpPattern - i, i);
  92.       i := -1;
  93.       WasStar := true;
  94.       if ( not ucRet ) then goto WhileRet;
  95.     end;
  96.     Inc(i);
  97.     Inc(cpPattern);
  98.   end;
  99.   ucRet := SerchPattern(cpPattern-i, i);
  100.   if ( not ucRet ) then goto WhileRet;
  101.   if ( (iLenStr <> 0) and ((cpPattern - 1)[0] <> ManyChars) ) then ucRet := false;
  102.   WhileRet:
  103.   Result := ucRet;
  104. end;
  105.  
  106. function FileLock(Handle, Offset, NumberOfBytes: Integer): Boolean;
  107. begin
  108.   Result := LockFile(THandle(Handle), Offset, 0, NumberOfBytes, 0);
  109. end;
  110.  
  111. function FileUnLock(Handle, Offset, NumberOfBytes: Integer): Boolean;
  112. begin
  113.   Result := UnlockFile(THandle(Handle), Offset, 0, NumberOfBytes, 0);
  114. end;
  115.  
  116. procedure ReplSign(var Strg: string);
  117. var
  118.   l, i: Integer;
  119. begin
  120.   l := Length(Strg);
  121.   for i := 1 to l do
  122.     Strg[i] := chr(ord(#44) - Ord(Strg[i]) + Ord(#48));
  123. end;
  124.  
  125. procedure ReplBlanks(var Strg: string; R: Char = '0');
  126. var
  127.   l, i: Integer;
  128. begin
  129.   l := Length(Strg);
  130.   for i := 1 to l do
  131.     if Strg[i] = ' ' then
  132.       Strg[i] := R;
  133. end;
  134.  
  135. function DtoS(d: TDateTime): String;
  136. const
  137.   ss: array [0..31] of string[2] = ('00', '01', '02', '03', '04', '05', '06', '07', '08', '09', '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', '20', '21', '22', '23', '24', '25', '26', '27', '28', '29', '30', '31');
  138. var
  139.   Year, Month, Day: Word;
  140.   s: ShortString;
  141. begin
  142.   DecodeDate(d, Year, Month, Day);
  143.   Int2Str(Year, 4, s);
  144.   Result := s + ss[Month] + ss[Day];
  145. end;
  146.  
  147. function DTtoS(d: TDateTime): String;
  148. const
  149.   ss: array [0..59] of string[2] = ('00', '01', '02', '03', '04', '05', '06', '07',
  150.                                     '08', '09', '10', '11', '12', '13', '14', '15',
  151.                                     '16', '17', '18', '19', '20', '21', '22', '23',
  152.                                     '24', '25', '26', '27', '28', '29', '30', '31',
  153.                                     '32', '33', '34', '35', '36', '37', '38', '39',
  154.                                     '40', '41', '42', '43', '44', '45', '46', '47',
  155.                                     '48', '49', '50', '51', '52', '53', '54', '55',
  156.                                     '56', '57', '58', '59');
  157. var
  158.   Year, Month, Day: Word;
  159.   Hour, Min, Sec, MSec: Word;
  160.   s: ShortString;
  161. begin
  162.   DecodeDate(d, Year, Month, Day);
  163.   DecodeTime(d, Hour, Min, Sec, MSec);
  164.   Int2Str(Year, 4, s);
  165.   Result := s + ss[Month] + ss[Day] + ss[Hour] + ss[Min] + ss[Sec];
  166. end;
  167.  
  168. function TtoS(d: TDateTime): String;
  169. const
  170.   ss: array [0..59] of string[2] = ('00', '01', '02', '03', '04', '05', '06', '07',
  171.                                     '08', '09', '10', '11', '12', '13', '14', '15',
  172.                                     '16', '17', '18', '19', '20', '21', '22', '23',
  173.                                     '24', '25', '26', '27', '28', '29', '30', '31',
  174.                                     '32', '33', '34', '35', '36', '37', '38', '39',
  175.                                     '40', '41', '42', '43', '44', '45', '46', '47',
  176.                                     '48', '49', '50', '51', '52', '53', '54', '55',
  177.                                     '56', '57', '58', '59');
  178. var
  179.   Hour, Min, Sec, MSec: Word;
  180. begin
  181.   DecodeTime(d, Hour, Min, Sec, MSec);
  182.   Result := ss[Hour] + ss[Min] + ss[Sec];
  183. end;
  184.  
  185. procedure Int2Str(val: Integer; width: Integer; var s: ShortString);
  186. asm
  187. {      ->EAX     Value
  188.         EDX     Width
  189.         ECX     Pointer to string       }
  190.  
  191.         PUSH    EBX             { VAR i: Longword;              }
  192.         PUSH    ESI             { VAR sign : Longint;           }
  193.         PUSH    EDI
  194.         PUSH    EDX             { store width on the stack      }
  195.         SUB     ESP,20          { VAR a: array [0..19] of Char; }
  196.  
  197.         MOV     EDI,ECX
  198.  
  199.         MOV     ESI,EAX         { sign := val                   }
  200.  
  201.         CDQ                     { val := Abs(val);  canned sequence }
  202.         XOR     EAX,EDX
  203.         SUB     EAX,EDX
  204.  
  205.         MOV     ECX,10
  206.         XOR     EBX,EBX         { i := 0;                       }
  207.  
  208. @@repeat1:                      { repeat                        }
  209.         XOR     EDX,EDX         {   a[i] := Chr( val MOD 10 + Ord('0') );}
  210.  
  211.         DIV     ECX             {   val := val DIV 10;          }
  212.  
  213.         ADD     EDX,'0'
  214.         MOV     [ESP+EBX],DL
  215.         INC     EBX             {   i := i + 1;                 }
  216.         TEST    EAX,EAX         { until val = 0;                }
  217.         JNZ     @@repeat1
  218.  
  219.         MOV     [EDI],BL        { s^++ := Chr(i);               }
  220.         INC     EDI
  221.  
  222.         mov     EDX, EDI
  223.  
  224.         MOV     ECX,[ESP+20]    { spaceCnt := width - i;        }
  225.         CMP     ECX,255
  226.         JLE     @@3
  227.         MOV     ECX,255
  228. @@3:
  229.         SUB     ECX,EBX
  230.         JLE     @@repeat2       { for k := 1 to spaceCnt do s^++ := '0';        }
  231.         ADD     [EDI-1],CL
  232.         MOV     AL,'0'
  233.         REP     STOSB
  234.  
  235. @@repeat2:                      { repeat                        }
  236.         MOV     AL,[ESP+EBX-1]  {   s^ := a[i-1];               }
  237.         MOV     [EDI],AL
  238.         INC     EDI             {   s := s + 1                  }
  239.         DEC     EBX             {   i := i - 1;                 }
  240.         JNZ     @@repeat2       { until i = 0;                  }
  241.  
  242.         TEST    ESI,ESI
  243.         JGE     @@2
  244.         MOV     AL, '-'
  245.         MOV     [EDX],AL
  246. @@2:
  247.  
  248.         ADD     ESP,20+4
  249.         POP     EDI
  250.         POP     ESI
  251.         POP     EBX
  252. end;
  253.  
  254.  
  255. //------------------------------------------------------------------------------
  256. function GetTmpFileName: String;
  257. var
  258.   cpBufferPath: pChar;
  259.   cpBufferTmpFile: pChar;
  260.   i: Integer;
  261. begin
  262.  
  263.   cpBufferPath := VKDBFMemMgr.oMem.GetMem(nil, MAX_PATH + 1);
  264.   FillChar(cpBufferPath^, MAX_PATH + 1, 0);
  265.  
  266.   cpBufferTmpFile := VKDBFMemMgr.oMem.GetMem(nil, MAX_PATH + 1);
  267.   FillChar(cpBufferTmpFile^, MAX_PATH + 1, 0);
  268.  
  269.   GetTempPath(MAX_PATH, cpBufferPath);
  270.  
  271.   for i := 0 to MAX_PATH - 1 do
  272.   begin
  273.     if Ord(cpBufferPath[i]) = 0 then break;
  274.     if Ord(cpBufferPath[i]) <= 32 then
  275.     begin
  276.       cpBufferPath[i] := '\';
  277.       cpBufferPath[i + 1] := #0;
  278.       break;
  279.     end;
  280.   end;
  281.  
  282.   GetTempFileName(cpBufferPath, PChar('VKT'), 0, cpBufferTmpFile);
  283.  
  284.   Result := Copy(cpBufferTmpFile, 1, Length(cpBufferTmpFile));
  285.  
  286.   VKDBFMemMgr.oMem.FreeMem(cpBufferPath);
  287.   VKDBFMemMgr.oMem.FreeMem(cpBufferTmpFile);
  288.  
  289. end;
  290.  
  291. //------------------------------------------------------------------------------
  292. function GetTmpPath: String;
  293. var
  294.   cpBufferPath: pChar;
  295.   i: Integer;
  296. begin
  297.  
  298.   cpBufferPath := VKDBFMemMgr.oMem.GetMem('GetTmpPath', MAX_PATH + 1);
  299.   FillChar(cpBufferPath^, MAX_PATH + 1, 0);
  300.  
  301.   GetTempPath(MAX_PATH, cpBufferPath);
  302.  
  303.   for i := 0 to MAX_PATH - 1 do
  304.   begin
  305.     if Ord(cpBufferPath[i]) = 0 then break;
  306.     if Ord(cpBufferPath[i]) <= 32 then
  307.     begin
  308.       cpBufferPath[i] := '\';
  309.       cpBufferPath[i + 1] := #0;
  310.       break;
  311.     end;
  312.   end;
  313.  
  314.   Result := Copy(cpBufferPath, 1, Length(cpBufferPath));
  315.  
  316.   VKDBFMemMgr.oMem.FreeMem(cpBufferPath);
  317.  
  318. end;
  319.  
  320. procedure WriteBugFile(FileName: String; Str: String);
  321. const
  322.   CR = #13#10;
  323. var
  324.   h: Integer;
  325.   q: String;
  326. begin
  327.   if FileExists(FileName) then
  328.     h := Sysutils.FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone)
  329.   else
  330.     h := Sysutils.FileCreate(FileName);
  331.   if h > 0 then begin
  332.     Sysutils.FileSeek(h, 0, 2);
  333.     DateTimeToString(q, 'dd.mm.yyyy hh:nn:ss ', now);
  334.     q := q + Str + CR;
  335.     Sysutils.FileWrite(h, pChar(q)^, Length(q));
  336.     Sysutils.FileClose(h);
  337.   end;
  338. end;
  339.  
  340. end.
  341.