📄 myldbdecutil.pas

📁 一个本地database引擎,支持中文T_Sql查询,兼容DELPHI标准数据库控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:

class function TStringFormat_HEX.ToStr(Value: PChar; Len: Integer): String;
var
  D: PByte;
  T: PChar;
  I,P: Integer;
  HasIdent: Boolean;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len div 2 +1);
  T := CharTable;
  D := PByte(Result);
  I := 0;
  HasIdent := False;
  while Len > 0 do
  begin
    P := TableFind(UpCase(Value^), T, 18);
    Inc(Value);
    if P >= 0 then
      if P > 16 then
      begin
        if not HasIdent then
        begin
          HasIdent := True;
          I := 0;
          D := PByte(Result);
        end;
      end else
      begin
        if Odd(I) then
        begin
          D^ := D^ or P;
          Inc(D);
        end else D^ := P shl 4;
        Inc(I);
      end;
    Dec(Len);
  end;
  SetLength(Result, PChar(D) - PChar(Result));
end;

class function TStringFormat_HEX.StrTo(Value: PChar; Len: Integer): String;
var
  D,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len * 2);
  T := CharTable;
  D := PChar(Result);
  while Len > 0 do
  begin
    D[0] := T[Byte(Value^) shr  4];
    D[1] := T[Byte(Value^) and $F];
    Inc(D, 2);
    Inc(Value);
    Dec(Len);
  end;
end;

class function TStringFormat_HEX.IsValid(Value: PChar; Len: Integer; ToStr: Boolean): Boolean;
var
  T: PChar;
  L: Integer;
begin
  Result := not ToStr;
  if not Result then
  begin
    T := CharTable;
    L := StrLen(T);
    while Len > 0 do
      if TableFind(Value^, T, L) >= 0 then
      begin
        Dec(Len);
        Inc(Value);
      end else Exit;
  end;
  Result := True;
end;

class function TStringFormat_HEX.Name: String;
begin
  Result := sFMT_HEX;
end;

class function TStringFormat_HEX.Format: Integer;
begin
  Result := fmtHEX;
end;

class function TStringFormat_HEX.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789ABCDEF'     // Table must be >= 18 Chars
      DB   'X$ abcdefhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TStringFormat_HEXL.Name: String;
begin
  Result := sFMT_HEXL;
end;

class function TStringFormat_HEXL.Format: Integer;
begin
  Result := fmtHEXL;
end;

class function TStringFormat_HEXL.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789abcdef'     // Table must be >= 18 Chars
      DB   'X$ ABCDEFhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TStringFormat_MIME64.ToStr(Value: PChar; Len: Integer): String;
var
  B: Cardinal;
  J,I: Integer;
  S,D,L,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := Length(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len);
  T := CharTable;
  //Move(PChar(Value)^, PChar(Result)^, Len);

  j:=1;
  S := PChar(Value);
  for i:=1 to Len do
   begin
    if TableFind(S^, T, 65) >=0 then
     begin
       Result[j] := S^;
       Inc(j);
     end;
    Inc(S);
   end;
  Len := j-1;
  SetLength(Result, Len);

  while Len mod 4 <> 0 do
  begin
    Result := Result + T[64];
    Inc(Len);
  end;

  D := PChar(Result);
  S := D;
  L := S + Len;
  Len := Len * 3 div 4;
  while Len > 0 do
  begin
    B := 0;
    J := 4;
    while (J > 0) and (S <= L) do
    begin
      I := TableFind(S^, T, 65);
      if I >= 0 then
      begin
        B := B shl 6;
        if I >= 64 then Dec(Len) else B := B or Byte(I);
        Dec(J);
      end;
      Inc(S);
    end;
    J := 2;
    repeat
      D[J] := Char(B);
      B := B shr 8;
      Dec(J);
    until J < 0;
    if Len > 3 then Inc(D, 3) else Inc(D, Len);
    Dec(Len, 3);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_MIME64.StrTo(Value: PChar; Len: Integer): String;
var
  B: Cardinal;
  I: Integer;
  D,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len * 4 div 3 + 4);
  D := PChar(Result);
  T := CharTable;
  while Len > 0 do
  begin
    B := 0;
    for I := 0 to 2 do
    begin
      B := B shl 8;
      if Len > 0 then
      begin
        B := B or Byte(Value^);
        Inc(Value);
      end;
      Dec(Len);
    end;
    for I := 3 downto 0 do
    begin
      if Len < 0 then
      begin
        D[I] := T[64];
        Inc(Len);
      end else D[I] := T[B and $3F];
      B := B shr 6;
    end;
    Inc(D, 4);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_MIME64.Name: String;
begin
  Result := sFMT_MIME64;
end;

class function TStringFormat_MIME64.Format: Integer;
begin
  Result := fmtMIME64;
end;

class function TStringFormat_MIME64.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 65 Chars
@@1:  DB  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='
      DB  ' $()[]{},;:-_\*"''',9,10,13,0
end;

class function TStringFormat_UU.ToStr(Value: PChar; Len: Integer): String;
var
  T,D,L: PChar;
  I,E: Integer;
  B: Cardinal;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len);
  L := Value + Len;
  D := PChar(Result);
  T := CharTable;
  repeat
    Len := TableFind(Value^, T, 64);
    if (Len < 0) or (Len > 45) then
      raise EStringFormat.CreateFMT(sInvalidStringFormat, [Name]);
    Inc(Value);
    while Len > 0 do
    begin
      B := 0;
      I := 4;
      while (I > 0) and (Value <= L) do
      begin
        E := TableFind(Value^, T, 64);
        if E >= 0 then
        begin
          B := B shl 6 or Byte(E);
          Dec(I);
        end;
        Inc(Value);
      end;
      I := 2;
      repeat
        D[I] := Char(B);
        B    := B shr 8;
        Dec(I);
      until I < 0;
      if Len > 3 then Inc(D, 3) else Inc(D, Len);
      Dec(Len, 3);
    end;
  until Value >= L;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_UU.StrTo(Value: PChar; Len: Integer): String;
var
  T,D: PChar;
  L,I: Integer;
  B: Cardinal;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len * 4 div 3 + Len div 45 + 10);
  D := PChar(Result);
  T := CharTable;
  while Len > 0 do
  begin
    L := Len;
    if L > 45 then L := 45;
    Dec(Len, L);
    D^ := T[L];
    while L > 0 do
    begin
      B := 0;
      for I := 0 to 2 do
      begin
        B := B shl 8;
        if L > 0 then
        begin
          B := B or Byte(Value^);
          Inc(Value);
        end;
        Dec(L);
      end;
      for I := 4 downto 1 do
      begin
        D[I] := T[B and $3F];
        B := B shr 6;
      end;
      Inc(D, 4);
    end;
    Inc(D);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_UU.Name: String;
begin
  Result := sFMT_UU;
end;

class function TStringFormat_UU.Format: Integer;
begin
  Result := fmtUU;
end;

class function TStringFormat_UU.IsValid(Value: PChar; Len: Integer; ToStr: Boolean): Boolean;
var
  T: PChar;
  L,I,P: Integer;
begin
  Result := not ToStr;
  if not Result then
  begin
    T := CharTable;
    L := StrLen(T);
    P := 0;
    while Len > 0 do
    begin
      I := TableFind(Value^, T, L);
      if I >= 0 then
      begin
        Dec(Len);
        Inc(Value);
        if P = 0 then
        begin
          if I > 45 then Exit;
          P := (I * 4 + 2) div 3;
        end else
          if I < 64 then Dec(P);
      end else Exit;
    end;
    if P <> 0 then Exit;
  end;
  Result := True;
end;

class function TStringFormat_UU.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 64 Chars
@@1:  DB   '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'
      DB   ' ',9,10,13,0
end;

class function TStringFormat_XX.Name: String;
begin
  Result := sFMT_XX;
end;

class function TStringFormat_XX.Format: Integer;
begin
  Result := fmtXX;
end;

class function TStringFormat_XX.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
      DB   ' "()[]''',9,10,13,0
end;

function CPUType: Integer;
begin
  Result := FCPUType;
end;

function IsObject(AObject: Pointer; AClass: TClass): Boolean;
var
  E: Pointer;
begin
  Result := False;
  if AObject = nil then Exit;
  E := ExceptionClass;
  ExceptionClass := nil;
  try
    if TObject(AObject) is AClass then Result := True;
  except
  end;
  ExceptionClass := E;
end;

function ROL(Value: LongWord; Shift: Integer): LongWord; assembler;
asm
       MOV   ECX,EDX
       ROL   EAX,CL
end;

function ROLADD(Value, Add: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROL   EAX,CL
       ADD   EAX,EDX
end;

function ROLSUB(Value, Sub: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROL   EAX,CL
       SUB   EAX,EDX
end;

function ROR(Value: LongWord; Shift: Integer): LongWord; assembler;
asm
       MOV   ECX,EDX
       ROR   EAX,CL
end;

function RORADD(Value, Add: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROR  EAX,CL
       ADD  EAX,EDX
end;

function RORSUB(Value, Sub: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROR  EAX,CL
       SUB  EAX,EDX
end;
{swap 4 Bytes Intel, Little/Big Endian Conversion}
function SwapInt(Value: LongWord): LongWord; assembler; register;
asm
       XCHG  AH,AL
       ROL   EAX,16
       XCHG  AH,AL
end;

function BSwapInt(Value: LongWord): LongWord; assembler; register;
asm
       BSWAP  EAX
end;

procedure SwapIntBuf(Source,Dest: Pointer; Count: Integer); assembler; register;
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   EBX
       SUB    EAX,4
       SUB    EDX,4
@@1:   MOV    EBX,[EAX + ECX * 4]
       XCHG   BL,BH
       ROL    EBX,16
       XCHG   BL,BH
       MOV    [EDX + ECX * 4],EBX
       DEC    ECX
       JNZ    @@1
       POP    EBX
@Exit:
end;

procedure BSwapIntBuf(Source, Dest: Pointer; Count: Integer); assembler; register;
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   EBX
       SUB    EAX,4
       SUB    EDX,4
@@1:   MOV    EBX,[EAX + ECX * 4]
       BSWAP  EBX
       MOV    [EDX + ECX * 4],EBX
       DEC    ECX
       JNZ    @@1
       POP    EBX
@Exit:
end;
{reverse the bit order from a integer}
function SwapBits(Value: LongWord): LongWord;
asm
       CMP    FCPUType,3
       JLE    @@1
       BSWAP  EAX
       JMP    @@2
@@1:   XCHG   AH,AL
       ROL    EAX,16
       XCHG   AH,AL
@@2:   MOV    EDX,EAX
       AND    EAX,0AAAAAAAAh
       SHR    EAX,1
       AND    EDX,055555555h
       SHL    EDX,1
       OR     EAX,EDX
       MOV    EDX,EAX
       AND    EAX,0CCCCCCCCh
       SHR    EAX,2
       AND    EDX,033333333h
       SHL    EDX,2
       OR     EAX,EDX
       MOV    EDX,EAX
       AND    EAX,0F0F0F0F0h
💿 文件大小 815 K
👤 上传用户 Butterflies
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#database #DELPHI #T_Sql #引擎
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -