Archive for the ‘Delphi’ Category

lkJSON-Delphi下使用json数据格式

Friday, June 19th, 2009
program sample1;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  uLkJSON in 'uLkJSON.pas';
var
  js:TlkJSONobject;
  ws: TlkJSONstring;
  s: String;
  i: Integer;
begin
  js := TlkJSONobject.Create;
//  js.add('namestring', TlkJSONstring.Generate('namevalue'));
  js.Add('namestring','namevalue');
// get the text of object
  s := TlkJSON.GenerateText(js);
  writeln(s);
  writeln;
  writeln('more readable variant:');
// (ver 1.03+) generate readable text
  i := 0;
  s := GenerateReadableText(js,i);
  writeln(s);
  js.Free;
// restore object (parse text)
  js := TlkJSON.ParseText(s) as TlkJSONobject;
// and get string back
// old syntax
  ws := js.Field['namestring'] as TlkJSONstring;
  s := ws.Value;
  writeln(s);
// syntax of 0.99+
  s := js.getString('namestring');
  writeln(s);
  readln;
  js.Free;
end.

DELPHI 屏幕截图

Friday, December 16th, 2005

//uses jpeg
procedure TForm1.snapscreen();
var
bmpscreen:Tbitmap;
jpegscreen:Tjpegimage;
FullscreenCanvas:TCanvas;
dc:HDC;
sourceRect, destRect: TRect;
begin
try
dc:=getdc(0);
fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=dc;
bmpscreen:=Tbitmap.create;
bmpscreen.Width :=screen.Width ;
bmpscreen.Height :=screen.Height ;
sourcerect:=rect(0,0,screen.Width ,screen.Height );
destrect:= rect(0,0,screen.Width ,screen.Height);
bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);
jpegscreen:=Tjpegimage.Create ;
jpegscreen.Assign (bmpscreen);
jpegscreen.CompressionQuality:=80;
jpegscreen.SaveToFile(ExtractFilePath(ParamStr(0))+’tmp.jpg’);
FullscreenCanvas.Free;
bmpscreen.Free;
jpegscreen.Free ;
ReleaseDC(0, DC);
except
end;
end;


Winsock API TCPServer(Delphi)

Monday, December 5th, 2005

program exe;
{$apptype console}

uses
Windows, Winsock, SysUtils
;

var
FSocket,CSocket:TSocket
;
buf:array[0..255]of char
;
wsaData:TWSADATA
;
Server:TSockAddrIn
;
err,len,id:integer
;
const
CRLF=#13#10
;
begin
err := WSAStartup(MAKEWORD(2,0),WSAData
);
if err=-1
then
begin
writeln(‘WSAStartup初始化失败!’
);
exit
;
end
;
FSocket := socket(AF_INET, SOCK_STREAM,0
);
if FSocket=SOCKET_ERROR
then
begin
writeln(‘socket创建套接口失败!’
);
WSACleanup
();
exit
;
end
;
Server.sin_family := AF_INET
;
Server.sin_addr.s_addr:=INADDR_ANY;
//host
Server.sin_port:=htons(40400);
//port
bind(FSocket,server,sizeof(server
));
len := sizeof(server
);
getsockname(FSocket,server,len
);
if listen(FSocket,5)<>0
then
begin
writeln(‘bind绑定错误!’
);
Closesocket(FSocket
);
WSACleanup
();
exit
;
end; CSocket:=accept(FSocket,@server,@len
);
if CSocket=-1
then
begin
writeln(‘CSocket连接错误!’
);
Closesocket(FSocket
);
WSACleanup
();
exit
;
end
;
id := connect(CSocket,Server, SizeOf(Server
));
if id <>0
then
begin
strcopy(buf
,
char($00)+char($00)+char($00)+char($00)+char($00)+char($00)+char($00
)+
char($00)+char($01)+char($00)+char($CA)+char($67)+char($43)+char($B4
)+
char($7F)+char($00)+char($00)+char($01)+char($D0)+char($9D)+char($DA
)+
char($10)+char($82)+char($02)+char($F4)+char($3F)+char($02)+char($43
)+
char($FF)+char($67)+char($D7)+char($D1)+char($12)+char($33)+char($6A
)+
char($A3)+char($D8)+char($C6)+char($24)+char($D8)+char($50)+char($19
)+
char($8B)+char($26)+char($00)+char($00)+char($00)+char($00)+char($77
)+
char($77)+char($77)+char($2E)+char($59)+char($6F)+char($63)+char($6B
)+
char($73)+char($6B)+char($59)+char($2E)+char($63)+char($6F)+char($6D
)+
char($00)+char($77)+char($77)+char($77)+char($2E)+char($59)+char($6F
)+
char($63)+char($6B)+char($73)+char($6B)+char($59)+char($2E)+char($63
)+
char($6F)+char($6D)+char($00)+char($77)+char($77)+char($77)+char($2E
)+
char($59)+char($6F)+char($63)+char($6B)+char($73)+char($6B)+char($59
)+
char($2E)+char($63)+char($6F)+char($6D)+char($00)+char($77)+char($77
)+
char($77)+char($2E)+char($59)+char($6F)+char($63)+char($6B)+char($73
)+
char($6B)+char($59)+char($2E)+char($63)+char($6F)+char($6D)+char($00
)+
char($77)+char($77)+char($77)+char($2E)+char($59)+char($6F)+char($63
)+
char($6B)+char($73)+char($6B)+char($59)+char($2E)+char($63)+char($6F
)+
char($6D)+char($00
)
);
send(CSocket,buf,strlen(buf),0
);
end
;
//    数据处理
strcopy(buf
,
char($00)+char($00)+char($00)+char($00)+char($00)+char($00)+char($00
)+
char($00)+char($01)+char($00)+char($CA)+char($67)+char($43)+char($B4
)+
char($7F)+char($00)+char($00)+char($01)+char($D0)+char($9D)+char($DA
)+
char($10)+char($82)+char($02)+char($F4)+char($3F)+char($02)+char($43
)+
char($FF)+char($67)+char($D7)+char($D1)+char($12)+char($33)+char($6A
)+
char($A3)+char($D8)+char($C6)+char($24)+char($D8)+char($50)+char($19
)+
char($8B)+char($26)+char($00)+char($00)+char($00)+char($00)+char($77
)+
char($77)+char($77)+char($2E)+char($59)+char($6F)+char($63)+char($6B
)+
char($73)+char($6B)+char($59)+char($2E)+char($63)+char($6F)+char($6D
)+
char($00)+char($77)+char($77)+char($77)+char($2E)+char($59)+char($6F
)+
char($63)+char($6B)+char($73)+char($6B)+char($59)+char($2E)+char($63
)+
char($6F)+char($6D)+char($00)+char($77)+char($77)+char($77)+char($2E
)+
char($59)+char($6F)+char($63)+char($6B)+char($73)+char($6B)+char($59
)+
char($2E)+char($63)+char($6F)+char($6D)+char($00)+char($77)+char($77
)+
char($77)+char($2E)+char($59)+char($6F)+char($63)+char($6B)+char($73
)+
char($6B)+char($59)+char($2E)+char($63)+char($6F)+char($6D)+char($00
)+
char($77)+char($77)+char($77)+char($2E)+char($59)+char($6F)+char($63
)+
char($6B)+char($73)+char($6B)+char($59)+char($2E)+char($63)+char($6F
)+
char($6D)+char($00
)
);
send(CSocket,buf,strlen(buf),0
);
repeat
recv(CSocket,buf,strlen(buf),0
);
send(CSocket,buf,strlen(buf),0
);
until pos(‘Q’,buf)>0
;

Closesocket(FSocket);
WSACleanup
();
end.

Delphi HexToInt的几个函数速度比较

Thursday, April 21st, 2005

unit unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls
;

type
TForm1 = class(TForm
)
Button1: TButton
;
Memo1: TMemo
;
procedure Button1Click(Sender: TObject
);
private
{ Private declarations }
public
{ Public declarations }
end
;

var
Form1: TForm1
;

implementation

{$R *.dfm}

const
HexStr: String = ‘ABCD1234′
;
CalcTimes: Integer = 1000000
;

type
THexToIntFunc = function(const S: String): DWORD
;

function HexToInt_tseug0(const S: String): DWORD;
asm
PUSH EBX
PUSH ESI

MOV ESI, EAX //字符串地址
MOV EDX, [EAX-4]
//读取字符串长度

XOR EAX, EAX //初始化返回值
XOR ECX, ECX
//临时变量

TEST ESI, ESI //判断是否为空指针
JZ @@2
TEST EDX, EDX
//判断字符串是否为空
JLE @@2
MOV BL, $20
@@0:
MOV CL, [ESI]
INC ESI

OR CL, BL //如果有字母则被转换为小写字母
sub CL, ’0′
JB @@2
// < ’0′ 的字符
CMP CL, $09
JBE @@1
// ’0′..’9′ 的字符
sub CL, ‘a’-’0′-10
CMP CL, $0A
JB @@2
// < ‘a’ 的字符
CMP CL, $0F
JA @@2
// > ‘f’ 的字符
@@1:
// ’0′..’9′, ‘A’..’F', ‘a’..’f’
SHL EAX, 4
OR EAX, ECX
DEC EDX
JNZ @@0
JMP @@3
@@2:
XOR EAX, EAX
// 非法16进制字符串
@@3:
POP ESI
POP EBX
RET
end
;

function HexToInt_tseug1(const S: String): DWORD;
var
: Integer
;
begin
Result := 0
;
for := 1 to Length(s)
do
begin
case
s[I]
of
’0′..’9′: Result := Result * 16 + Ord(S[I]) – Ord(’0′
);
‘A’..‘F’: Result := Result * 16 + Ord(S[I]) – Ord(‘A’) + 10
;
‘a’..‘f’: Result := Result * 16 + Ord(S[I]) – Ord(‘a’) + 10
;
else
Result := 0
;
Exit
;
end
;
end
end
;

function HexToInt_DoubleWood(const S: string): DWORD;
const
Convert: array[0..255] of Integer
=
(
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1
,
-
1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
,
-
1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-
1
);
var
I: Integer
;
v: Integer
;
begin
Result := 0
;
if Pointer(s) = nil then exit
;
for := 1 to PInteger(Integer(s) – 4)^
do
begin
begin
:= Convert[ord(s[i
])];
if V<0
then
begin
Result := 0
;
Exit
;
end
;
result := (result * 16) or V
;
end
;
end
;
end
;

function HexToInt_beta1(const S: string): DWORD;
const
ValidateTbl: array [0..255] of Byte
= (
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
);
asm
push ebx
push ecx
push edx
push esi
push edi

mov esi, eax //字符串地址
mov ecx, [eax-4]
//读取字符串长度
test esi, esi
//判断是否为空指针
jz @Err
test ecx, ecx
//判断字符串是否为空
jle @Err

xor eax, eax
lea edi, ValidateTbl
mov edx, ecx
xor ebx, ebx
@LoopValidate:
mov bl, [esi]
mov bl, [edi][ebx]
test ebx, 16
jnz @Err

shl eax, 4
or eax, ebx

inc esi
dec edx
jnz @LoopValidate

jmp @Ext
@Err:
xor eax, eax // 非法16进制字符串
@Ext:

pop edi
pop esi
pop edx
pop ecx
pop ebx
end;

function HexToInt_beta2(const S: string): DWORD;
const
ValidateTbl: array [0..255] of Byte
= (
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 10, 11, 12, 13, 14, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16
);
asm
push ebx
push ecx
push edx
push esi
push edi

mov edi, esp
push 0

mov esi, eax //字符串地址
mov ecx, [eax - 4]
//读取字符串长度
test esi, esi
//判断是否为空指针
jz @Err
test ecx, ecx
//判断字符串是否为空
jle @Err

lea eax, ValidateTbl
xor edx, edx
xor ebx, ebx

test ecx, 1
jz @LeftBytes

//FirstByte:
mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
shl bl, 4
dec edi
mov [edi], bl

dec ecx
jz @Ext

@LeftBytes:
mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
mov dl, bl
shl dl, 4
inc esi

mov bl, [esi]
mov bl, [eax][ebx]
test ebx, 16
jnz @Err
or bl, dl
dec edi
mov [edi], bl
inc esi

dec ecx
dec ecx
jnz @LeftBytes

jmp @Ext
@Err:
mov [esp], 0
@Ext:
pop eax

pop edi
pop esi
pop edx
pop ecx
pop ebx
end;

// 测试函数,让制定的计算方法多执行几次,以拉开时间差距
function TestHexToInt(HexToIntFunc: THexToIntFunc; var Value: DWORD): DWord
;
var
I: Integer
;
begin
Result := GetTickCount
;

for := 1 to CalcTimes do
Value := HexToIntFunc(HexStr
);

Result := GetTickCount - Result;
end
;

procedure TForm1.Button1Click(Sender: TObject);
var
Value: DWORD
;
begin
Memo1.Lines.Add(Format(‘HexToInt_tseug0 (%dms).’, [TestHexToInt(HexToInt_tseug0, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_tseug1 (%dms).’, [TestHexToInt(HexToInt_tseug1, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_DoubleWood (%dms).’, [TestHexToInt(HexToInt_DoubleWood, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_beta1 (%dms).’, [TestHexToInt(HexToInt_beta1, Value
)]));
Memo1.Lines.Add(Format(‘HexToInt_beta2 (%dms).’, [TestHexToInt(HexToInt_beta2, Value
)]));
Memo1.Lines.Add(’1234′
);
end
;

end.

DELPHI加注册表自启动的最简单代码

Wednesday, April 20th, 2005

program exe;
uses
windows
;
// 注册表新建键值的函数
procedure CreateKey(const RootKey : HKey; Key, ValueName, Value: string
);
var
Handle: HKey
;
Res
,
Disposition: Integer
;
begin
Res := RegCreateKeyEx(RootKey, PChar(Key), 0,
,
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, Handle, @Disposition
);
if Res = 0
then begin
Res := RegSetValueEx(Handle, PChar(ValueName), 0
,
REG_SZ, PChar(Value), Length(Value) + 1
);
RegCloseKey(Handle
)
end
;
end
;
begin
//  跟                       位置                                      名          文件路径
CreateKey(HKEY_LOCAL_MACHINE,‘SoftWare\Microsoft\Windows\CurrentVersion\Run’,‘AutoRun’,‘C:\WINDOWS\regedit.exe’
);
end
.
////////////////////////////////////////////////////////
以前的代码,要用到registry,不适合写木马哦,要大好几K
呢。
标题
DELPHI加注册表自启动的最简单代码 选择自 jondynet
Blog
关键字 DELPHI
加注册表自启动的最简单代码
出处
uses registry
;
var reg:tregistry
;
begin
reg:=tregistry.create
;
reg.rootkey:=HKEY_LOCAL_MACHINE
;
reg.openkey(‘SOFTWARE\Microsoft\Windows\CurrentVersion\Run’,true
);
reg.WriteString(‘ScanRegistry’,‘mir47.EXE’
);
reg.closekey
;
reg.free
;
end
.