https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257572 Thu, 04 Dec 2003 14:00:13 +0000 https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257572 http://www.delphimaster.ru/cgi-bin/faq.pl?... ]]> alexdosh Delphi: Сетевое программирование https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257546 Thu, 04 Dec 2003 13:34:30 +0000 https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257546 Буду искать еще теорию и слабые места... ]]> Mischka Delphi: Сетевое программирование https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257469 Thu, 04 Dec 2003 12:17:29 +0000 https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257469 Для Делфи 5
*)
{КЛИЕНТ}
unit Unit1;

interface

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

type
TfrmClient = class(TForm)
clt_send: TNMMsg;
serv_resiv: TNMMSGServ;
edIP: TEdit;
btnSend: TButton;
cbCmd: TComboBox;
Label1: TLabel;
label2: TLabel;
mOut: TMemo;
procedure FormCreate(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure serv_resivMSG(Sender: TComponent; const sFrom, sMsg: String);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmClient: TfrmClient;
SPORT, RPORT: integer;
RHOST: string;

implementation

{$R *.DFM}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
SPORT:=6661;
RPORT:=6660;
end;

procedure TfrmClient.btnSendClick(Sender: TObject);
var
cmd: string;// command|parametr|dump|dump|dump
begin
(*
ShutDown
ReBoot
NetSend|text aKa Param
Change
Start|Param
Remember|Param //RememberCLNTip
FuckReg
StarExplorer
Exit
-CopyToAll
*)
if (edIP.text <> '') and (cbCmd.Text <> '')then
begin
RHOST := edIP.text;//LOCALHOST; //test
cmd := cbCmd.text + '|dump|dump|dump';
//
clt_send:=TNMMsg.Create(Self);
clt_send.Host:=RHOST;
clt_send.Port:=SPORT;
clt_send.FromName:='Client';
clt_send.PostIt(cmd);
clt_send.Free;
end
else showmessage('!Not enought actual parametrs!');
end;

procedure TfrmClient.serv_resivMSG(Sender: TComponent; const sFrom,
sMsg: String);
begin
mOut.Clear;
mOut.Lines.add('<==|'+chr(VK_TAB)+sFrom+chr(VK_TAB)+'|==>');
mOut.text := mOut.text + sMsg;
mOut.Lines.add('<==|'+chr(VK_TAB)+'END'+chr(VK_TAB)+'|==>');
end;

end.


{СЕРВЕР}
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Psock, NMMSG, ExtCtrls, StdCtrls, KernlUtl, inifiles, shellapi, Registry,
TlHelp32, WinSock;

Function GetWinPath:String;
Function GetExePath:string;

type
TfrmServ = class(TForm)
clt_send: TNMMsg;
serv_resiv: TNMMSGServ;
procedure FormCreate(Sender: TObject);
procedure serv_resivMSG(Sender: TComponent; const sFrom, sMsg: String);
procedure serv_resivClientContact(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

const
LOCALHOST = '127.0.0.1';

var
frmServ: TfrmServ;
RHOST: String;
SPORT, RPORT: integer;

implementation

{$R *.DFM}
(**)
//....
procedure StrDiv(str:string; var txt,path,zakladka,comPort,startMtd:string);
var
i,j,len_str:integer;
jmp:byte;
begin
jmp:=0;
//str:=str+'.';
len_str:=length(str);
for i:=1 to len_str do begin
if (str[i]='|') then begin
inc(jmp);
if (jmp=1) then begin
txt:=copy(str,0,i-1);
j:=i+1;
end;
if (jmp=2) then begin
path:=copy(str,j,i-j);
j:=i+1;
end;
if (jmp=3) then begin
zakladka:=copy(str,j,i-j);
j:=i+1;
end;
if (jmp=4) then begin
comPort:=copy(str,j,i-j);
j:=i+1;
end;
if (jmp=5) then begin
startMtd:=copy(str,j,i-j);
end;
end;
end;
end;
//

Function GetSelfIP: string;
var
WSAData : TWSAData;
p : PHostEnt;
Name : array [0..$FF] of Char;
begin WSAStartup($0101, WSAData);
GetHostName(name, $FF);
p := GetHostByName(Name);
Result := inet_ntoa(PInAddr(p.h_addr_list^)^);
WSACleanup;
end;
(**)

procedure TfrmServ.FormCreate(Sender: TObject);
begin
frmServ.Width := 0;
frmServ.Height := 0;
SPORT := 6660;
RPORT := 6661;
RHOST := '192.168.0.1';
end;

(*
//RHOST := LOCALHOST; //test
//Послать по сети
{
clt_send:=TNMMsg.Create(Self);
clt_send.Host:=RHOST;
clt_send.Port:=SPORT;
clt_send.FromName:='Client';
clt_send.PostIt(strMsg);
clt_send.Free;
}
*)
procedure TfrmServ.serv_resivMSG(Sender: TComponent; const sFrom,
sMsg: String);
(*/\*)
//
procedure Errore(code: byte);
var
err: string;
begin
err := '';
case code of
0: err := 'Нормально';
1: err := 'SendText не работает';
2: err := 'Kill не работает';
3: err := '';
255: err := '';
else
err := 'Не нормально';
end;
if code <> 0 then begin
clt_send := TNMMsg.Create(Self);
clt_send.Host := RHOST;
clt_send.Port := SPORT;
clt_send.FromName := GetSelfIP;
clt_send.PostIt(err);
clt_send.Free;
end;
end;
//
Function SendText(str: string; text:TStringList):byte;
begin
if(str <> '')then
begin
clt_send := TNMMsg.Create(Self);
clt_send.Host := RHOST;
clt_send.Port := SPORT;
clt_send.FromName := GetSelfIP;
clt_send.PostIt(str);
clt_send.Free;
result := 0;
end
else
if(text <> nil)then
begin
clt_send := TNMMsg.Create(Self);
clt_send.Host := RHOST;
clt_send.Port := SPORT;
clt_send.FromName := GetSelfIP;
clt_send.PostIt(text.Text);
clt_send.Free;
result := 0;
end
else result := 1;
end;
//

//
(*/\*)
var
command,param,dump,tmp:string;
PSList: TStringList;
//
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
PID:DWORD;
i,j:integer;
pStr:String;
snapShot:THandle;

begin
PSList := TStringList.Create;
(*
ShutDown
ReBoot
NetSend(text aKa Param)
Change
Start(Param)
Remember(Param)
FuckReg
StarExplorer
Exit
ps
Kill(Param)
*)
Command := '';
param := '';
tmp := sMsg+'|';
StrDiv(tmp,Command,Param,dump,dump,dump);
if Command='ShutDown' then showmessage('ShutDown')
else if Command='ReBoot' then showmessage('ReBoot')
else if Command='NetSend' then showmessage(Param)
else if Command='Change' then showmessage('Change')
else if Command='Start' then showmessage('Starter( ' + Param + ' )')
else if Command='Remember' then showmessage('RememberCLNTip( '+ Param +' )')
else if Command='FuckReg' then showmessage('FuckReg')
else if Command='StarExplorer' then showmessage('StarExplorer')
else if Command='Exit' then Application.MainForm.Close
else if Command='ps' then showmessage('ps');
end;


procedure TfrmServ.serv_resivClientContact(Sender: TObject);
begin
serv_resiv.ReportLevel := Status_Basic;
end;

procedure TfrmServ.FormActivate(Sender: TObject);
begin
ShowWindow(Application.Handle,sw_Hide);
end;

procedure TfrmServ.FormDestroy(Sender: TObject);
begin
serv_resiv.Free;
end;

procedure TfrmServ.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin

end;

end.

Я повырезал некоторые функции так что может кое что будет ругаться, но пересылка строк должна работать! ПОСМОТРИ ПРИМЕРЫ ПРОГРАММ С ДЕЛФИ!!!!!ТАМ ДОЛЖЕН БЫТЬ ЧАТ... ]]> alexdosh Delphi: Сетевое программирование https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257455 Thu, 04 Dec 2003 12:05:39 +0000 https://forum.sources.ru/index.php?showtopic=39737&view=findpost&p=257455 Хотел писать на WinAPI. Тяжело так сразу, решил использовать компоненты. Скачал кучу статей про сокеты, прочитал, разобрался. Написал код - не работает. Лучшее, чего удалось добиться - отсутствие run-time error и сообщения клиента и сервера о передаче информации, а самой информации нету

Люди, дайте любой (работающий) пример пересылки содержимого строки S по сетке с IP1 на IP2 ]]> Mischka Delphi: Сетевое программирование