📄 myldbdecutil.pas
字号:
SHR EAX,4
AND EDX,00F0F0F0Fh
SHL EDX,4
OR EAX,EDX
end;
function LSBit(Value: Integer): Integer; assembler;
asm
BSF EAX,EAX
end;
function MSBit(Value: Integer): Integer; assembler;
asm
BSR EAX,EAX
end;
function OneBit(Value: Integer): Integer; assembler;
asm
MOV ECX,EAX
MOV EDX,EAX
BSF EDX,EDX
JZ @@1
BSR ECX,ECX
CMP ECX,EDX
JNE @@1
MOV EAX,EDX
RET
@@1: XOR EAX,EAX
end;
function MemCompare(P1, P2: Pointer; Size: Integer): Integer; assembler; register;
asm
PUSH ESI
PUSH EDI
MOV ESI,P1
MOV EDI,P2
XOR EAX,EAX
REPE CMPSB
JE @@1
MOVZX EAX,BYTE PTR [ESI-1]
MOVZX EDX,BYTE PTR [EDI-1]
SUB EAX,EDX
@@1: POP EDI
POP ESI
end;
procedure XORBuffers(I1, I2: Pointer; Size: Integer; Dest: Pointer); assembler;
asm
AND ECX,ECX
JZ @@5
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,Dest
@@1: TEST ECX,3
JNZ @@3
@@2: SUB ECX,4
JL @@4
MOV EAX,[ESI + ECX]
XOR EAX,[EDX + ECX]
MOV [EDI + ECX],EAX
JMP @@2
@@3: DEC ECX
MOV AL,[ESI + ECX]
XOR AL,[EDX + ECX]
MOV [EDI + ECX],AL
JMP @@1
@@4: POP EDI
POP ESI
@@5:
end;
procedure DoProgress(Sender: TObject; Current, Maximal: Integer);
begin
{saver access}
if (TMethod(Progress).Code <> nil) and
((TMethod(Progress).Data = nil) or
IsObject(TMethod(Progress).Data, TObject)) then
Progress(Sender, Current, Maximal);
end;
function StringFormat(Format: Integer): TStringFormatClass;
var
I: Integer;
begin
if Format = fmtDefault then Format := DefaultStringFormat;
Result := nil;
if FStrFmts <> nil then
for I := 0 to FStrFMTs.Count-1 do
if TStringFormatClass(FStrFmts[I]).Format = Format then
begin
Result := FStrFMTS[I];
Exit;
end;
end;
function StrToFormat(Value: PChar; Len, Format: Integer): String;
var
Fmt: TStringFormatClass;
begin
Result := '';
if (Value = nil) or (Format = fmtNONE) then Exit;
if Len < 0 then Len := StrLen(Value);
if Len <= 0 then Exit;
Fmt := StringFormat(Format);
if Fmt <> nil then
if Fmt.IsValid(Value, Len, False) then Result := Fmt.StrTo(Value, Len)
else raise EStringFormat.CreateFMT(sInvalidFormatString, [FMT.Name])
else raise EStringFormat.CreateFMT(sStringFormatExists, [Format]);
end;
function FormatToStr(Value: PChar; Len, Format: Integer): String;
var
Fmt: TStringFormatClass;
begin
Result := '';
if (Value = nil) or (Format = fmtNONE) then Exit;
if Len < 0 then Len := StrLen(Value);
if Len = 0 then Exit;
Fmt := StringFormat(Format);
if Fmt <> nil then
if Fmt.IsValid(Value, Len, True) then Result := Fmt.ToStr(Value, Len)
else raise EStringFormat.CreateFMT(sInvalidStringFormat, [FMT.Name])
else raise EStringFormat.CreateFMT(sStringFormatExists, [Format]);
end;
function ConvertFormat(Value: PChar; Len, FromFormat, ToFormat: Integer): String;
begin
Result := '';
if (FromFormat = fmtNONE) or (ToFormat = fmtNONE) then Exit;
if FromFormat <> ToFormat then
begin
Result := FormatToStr(Value, Len, FromFormat);
Result := StrToFormat(PChar(Result), Length(Result), ToFormat);
end else
begin
if Value = nil then Exit;
if Len < 0 then Len := StrLen(Value);
if Len = 0 then Exit;
SetLength(Result, Len);
Move(Value^, PChar(Result)^, Len);
end;
end;
function IsValidFormat(Value: PChar; Len, Format: Integer): Boolean;
var
Fmt: TStringFormatClass;
begin
Result := True;
if Value = nil then Exit;
if Len < 0 then Len := StrLen(Value);
if Len = 0 then Exit;
Fmt := StringFormat(Format);
if Fmt = nil then Result := False
else Result := Fmt.IsValid(Value, Len, True);
end;
function IsValidString(Value: PChar; Len, Format: Integer): Boolean;
var
Fmt: TStringFormatClass;
begin
Result := True;
if Value = nil then Exit;
if Len < 0 then Len := StrLen(Value);
if Len = 0 then Exit;
Fmt := StringFormat(Format);
if Fmt = nil then Result := False
else Result := Fmt.IsValid(Value, Len, False);
end;
procedure RegisterStringFormats(const StringFormats: array of TStringFormatClass);
var
I,J: Integer;
FMT: TStringFormatClass;
begin
if FStrFMTs = nil then FStrFMTs := TList.Create;
for I := Low(StringFormats) to High(StringFormats) do
if (StringFormats[I] <> nil) and
(StringFormats[I].Format <> fmtDEFAULT) then
begin
FMT := StringFormat(StringFormats[I].Format);
if FMT <> nil then
begin
J := FStrFMTs.IndexOf(FMT);
FStrFMTs[J] := StringFormats[I];
end else FStrFMTs.Add(StringFormats[I]);
end;
end;
procedure GetStringFormats(Strings: TStrings);
var
I: Integer;
begin
if IsObject(Strings, TStrings) and (FStrFMTs <> nil) then
for I := 0 to FStrFMTs.Count-1 do
Strings.AddObject(TStringFormatClass(FStrFMTs[I]).Name, FStrFMTs[I]);
end;
function InsertCR(const Value: String; BlockSize: Integer): String;
var
I: Integer;
S,D: PChar;
begin
if (BlockSize <= 0) or (Length(Value) <= BlockSize) then
begin
Result := Value;
Exit;
end;
I := Length(Value);
SetLength(Result, I + I * 2 div BlockSize + 2);
S := PChar(Value);
D := PChar(Result);
repeat
Move(S^, D^, BlockSize);
Inc(S, BlockSize);
Inc(D, BlockSize);
D^ := #13; Inc(D);
D^ := #10; Inc(D);
Dec(I, BlockSize);
until I < BlockSize;
Move(S^, D^, I);
Inc(D, I);
SetLength(Result, D - PChar(Result));
end;
function DeleteCR(const Value: String): String;
var
S,D: PChar;
I: Integer;
begin
I := Length(Value);
SetLength(Result, I);
D := PChar(Result);
S := PChar(Value);
while I > 0 do
begin
if (S^ <> #10) and (S^ <> #13) then
begin
D^ := S^;
Inc(D);
end;
Inc(S);
Dec(I);
end;
SetLength(Result, D - PChar(Result));
end;
function InsertBlocks(const Value, BlockStart, BlockEnd: String; BlockSize: Integer): String;
var
I,LS,LE: Integer;
D,S: PChar;
begin
if (BlockSize <= 0) or (Length(Value) <= BlockSize) then
begin
Result := Value;
Exit;
end;
I := Length(Value);
LS := Length(BlockStart);
LE := Length(BlockEnd);
SetLength(Result, I + (I div BlockSize + 1) * (LS + LE));
S := PChar(Value);
D := PChar(Result);
repeat
Move(PChar(BlockStart)^, D^, LS); Inc(D, LS);
Move(S^, D^, BlockSize); Inc(D, BlockSize);
Move(PChar(BlockEnd)^, D^, LE); Inc(D, LE);
Dec(I, BlockSize);
Inc(S, BlockSize);
until I < BlockSize;
if I > 0 then
begin
Move(PChar(BlockStart)^, D^, LS); Inc(D, LS);
Move(S^, D^, I); Inc(D, I);
Move(PChar(BlockEnd)^, D^, LE); Inc(D, LE);
end;
SetLength(Result, D - PChar(Result));
end;
function RemoveBlocks(const Value, BlockStart, BlockEnd: String): String;
var
LS,LE: Integer;
S,D,L,K: PChar;
begin
SetLength(Result, Length(Value));
LS := Length(BlockStart);
LE := Length(BlockEnd);
D := PChar(Result);
S := PChar(Value);
L := S + Length(Value);
repeat
if S > L then Break;
if LS > 0 then
begin
S := StrPos(S, PChar(BlockStart));
if S = nil then Break;
Inc(S, LS);
if S > L then Break;
end;
K := StrPos(S, PChar(BlockEnd));
if K = nil then K := L;
Move(S^, D^, K - S);
Inc(D, K - S);
S := K + LE;
until S >= L;
SetLength(Result, D - PChar(Result));
end;
function GetShortClassName(Value: TClass): String;
var
I: Integer;
begin
Result := '';
if Value = nil then Exit;
Result := Value.ClassName;
I := Pos('_', Result);
if I > 0 then Delete(Result, 1, I);
end;
function RndXORBuffer(Seed: Integer; var Buffer; Size: Integer): Integer; assembler;
asm
AND EDX,EDX
JZ @@2
AND ECX,ECX
JLE @@2
PUSH EBX
@@1: XOR AL,[EDX]
IMUL EAX,EAX,134775813
INC EAX
MOV EBX,EAX
SHR EBX,24
MOV [EDX],BL
INC EDX
DEC ECX
JNZ @@1
POP EBX
@@2:
end;
// use Systemtime and XOR's with Performancecounter
function RndTimeSeed: Integer; assembler;
var
SysTime: record
Year: Word;
Month: Word;
DayOfWeek: Word;
Day: Word;
Hour: Word;
Minute: Word;
Second: Word;
MilliSeconds: Word;
Reserved: array [0..7] of Byte;
end;
Counter: record
Lo,Hi: Integer;
end;
asm
LEA EAX,SysTime
PUSH EAX
CALL GetSystemTime
MOVZX EAX,Word Ptr SysTime.Hour
IMUL EAX,60
ADD AX,SysTime.Minute
IMUL EAX,60
MOVZX EDX,Word Ptr SysTime.Second
ADD EAX,EDX
IMUL EAX,1000
MOV DX,SysTime.MilliSeconds
ADD EAX,EDX
PUSH EAX
LEA EAX,Counter
PUSH EAX
CALL QueryPerformanceCounter
POP EAX
XOR EAX,Counter.Lo
XOR EAX,Counter.Hi
end;
function CRC16(CRC: Word; Data: Pointer; DataSize: LongWord): Word; assembler;
asm
AND EDX,EDX
JZ @Exit
AND ECX,ECX
JLE @Exit
PUSH EBX
PUSH EDI
XOR EBX,EBX
LEA EDI,CS:[OFFSET @CRC16]
@Start: MOV BL,[EDX]
XOR BL,AL
SHR AX,8
XOR AX,[EDI + EBX * 2]
INC EDX
DEC ECX
JNZ @Start
POP EDI
POP EBX
@Exit: RET
NOP
@CRC16: DW 00000h, 0C0C1h, 0C181h, 00140h, 0C301h, 003C0h, 00280h, 0C241h
DW 0C601h, 006C0h, 00780h, 0C741h, 00500h, 0C5C1h, 0C481h, 00440h
DW 0CC01h, 00CC0h, 00D80h, 0CD41h, 00F00h, 0CFC1h, 0CE81h, 00E40h
DW 00A00h, 0CAC1h, 0CB81h, 00B40h, 0C901h, 009C0h, 00880h, 0C841h
DW 0D801h, 018C0h, 01980h, 0D941h, 01B00h, 0DBC1h, 0DA81h, 01A40h
DW 01E00h, 0DEC1h, 0DF81h, 01F40h, 0DD01h, 01DC0h, 01C80h, 0DC41h
DW 01400h, 0D4C1h, 0D581h, 01540h, 0D701h, 017C0h, 01680h, 0D641h
DW 0D201h, 012C0h, 01380h, 0D341h, 01100h, 0D1C1h, 0D081h, 01040h
DW 0F001h, 030C0h, 03180h, 0F141h, 03300h, 0F3C1h, 0F281h, 03240h
DW 03600h, 0F6C1h, 0F781h, 03740h, 0F501h, 035C0h, 03480h, 0F441h
DW 03C00h, 0FCC1h, 0FD81h, 03D40h, 0FF01h, 03FC0h, 03E80h, 0FE41h
DW 0FA01h, 03AC0h, 03B80h, 0FB41h, 03900h, 0F9C1h, 0F881h, 03840h
DW 02800h, 0E8C1h, 0E981h, 02940h, 0EB01h, 02BC0h, 02A80h, 0EA41h
DW 0EE01h, 02EC0h, 02F80h, 0EF41h, 02D00h, 0EDC1h, 0EC81h, 02C40h
DW 0E401h, 024C0h, 02580h, 0E541h, 02700h, 0E7C1h, 0E681h, 02640h
DW 02200h, 0E2C1h, 0E381h, 02340h, 0E101h, 021C0h, 02080h, 0E041h
DW 0A001h, 060C0h, 06180h, 0A141h, 06300h, 0A3C1h, 0A281h, 06240h
DW 06600h, 0A6C1h, 0A781h, 06740h, 0A501h, 065C0h, 06480h, 0A441h
DW 06C00h, 0ACC1h, 0AD81h, 06D40h, 0AF01h, 06FC0h, 06E80h, 0AE41h
DW 0AA01h, 06AC0h, 06B80h, 0AB41h, 06900h, 0A9C1h, 0A881h, 06840h
DW 07800h, 0B8C1h, 0B981h, 07940h, 0BB01h, 07BC0h, 07A80h, 0BA41h
DW 0BE01h, 07EC0h, 07F80h, 0BF41h, 07D00h, 0BDC1h, 0BC81h, 07C40h
DW 0B401h, 074C0h, 07580h, 0B541h, 07700h, 0B7C1h, 0B681h, 07640h
DW 07200h, 0B2C1h, 0B381h, 07340h, 0B101h, 071C0h, 07080h, 0B041h
DW 05000h, 090C1h, 09181h, 05140h, 09301h, 053C0h, 05280h, 09241h
DW 09601h, 056C0h, 05780h, 09741h, 05500h, 095C1h, 09481h, 05440h
DW 09C01h, 05CC0h, 05D80h, 09D41h, 05F00h, 09FC1h, 09E81h, 05E40h
DW 05A00h, 09AC1h, 09B81h, 05B40h, 09901h, 059C0h, 05880h, 09841h
DW 08801h, 048C0h, 04980h, 08941h, 04B00h, 08BC1h, 08A81h, 04A40h
DW 04E00h, 08EC1h, 08F81h, 04F40h, 08D01h, 04DC0h, 04C80h, 08C41h
DW 04400h, 084C1h, 08581h, 04540h, 08701h, 047C0h, 04680h, 08641h
DW 08201h, 042C0h, 04380h, 08341h, 04100h, 081C1h, 08081h, 04040h
end;
{a Random generated Testvector 256bit - 32 Bytes, it's used for Self Test}
function GetTestVector: PChar; assembler; register;
asm
MOV EAX,OFFSET @Vector
RET
@Vector: DB 030h,044h,0EDh,06Eh,045h,0A4h,096h,0F5h
DB 0F6h,035h,0A2h,0EBh,03Dh,01Ah,05Dh,0D6h
DB 0CBh,01Dh,009h,082h,02Dh,0BDh,0F5h,060h
DB 0C2h,0B8h,058h,0A1h,091h,0F9h,081h,0B1h
DB 000h,000h,000h,000h,000h,000h,000h,000h
end;
{get the CPU Type from your system}
function GetCPUType: Integer; assembler;
asm
PUSH EBX
PUSH ECX
PUSH EDX
MOV EBX,ESP
AND ESP,0FFFFFFFCh
PUSHFD
PUSHFD
POP EAX
MOV ECX,EAX
XOR EAX,40000h
PUSH EAX
POPFD
PUSHFD
POP EAX
XOR EAX,ECX
MOV EAX,3
JE @Exit
PUSHFD
POP EAX
MOV ECX,EAX
XOR EAX,200000h
PUSH EAX
POPFD
PUSHFD
POP EAX
XOR EAX,ECX
MOV EAX,4
JE @Exit
PUSH EBX
MOV EAX,1
DB 0Fh,0A2h //CPUID
MOV AL,AH
AND EAX,0Fh
POP EBX
@Exit: POPFD
MOV ESP,EBX
POP EDX
POP ECX
POP EBX
end;
procedure ModuleUnload(Instance: Integer);
var // automaticaly deregistration
I: Integer;
begin
if FStrFMTs <> nil then
for I := FStrFMTs.Count-1 downto 0 do
if FindClassHInstance(TClass(FStrFMTs[I])) = LongWord(Instance) then
FStrFMTs.Delete(I);
end;
initialization
AddModuleUnloadProc(ModuleUnload);
FCPUType := GetCPUType;
if FCPUType > 3 then
begin
SwapInteger := BSwapInt;
SwapIntegerBuffer := BSwapIntBuf;
end else
begin
SwapInteger := SwapInt;
SwapIntegerBuffer := SwapIntBuf;
end;
RegisterStringFormats([TStringFormat, TStringFormat_HEX, TStringFormat_HEXL,
TStringFormat_MIME64, TStringFormat_UU, TStringFormat_XX]);
finalization
RemoveModuleUnloadProc(ModuleUnload);
FStrFMTs.Free;
FStrFMTs := nil;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -