Ahoj,
nasiel som priklad na internete:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, IdTCPServer, IdSocketHandle, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent,
IdComponent, Buttons, ExtCtrls, Jpeg, ImgList, ComCtrls, ToolWin,
IdAntiFreezeBase, IdAntiFreeze, IdStack, SyncObjs;
type
PClient = ^TClient;
TClient = record
PeerIP: string[15];
HostName: String[40];
TakeShot: boolean;
Connected, LastAction: TDateTime;
Thread: Pointer;
end;
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
StatusBar1: TStatusBar;
ListBox1: TListBox;
Image1: TImage;
Label1: TLabel;
Button1: TButton;
IdThreadMgrDefault1: TIdThreadMgrDefault;
IdAntiFreeze1: TIdAntiFreeze;
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure RefreshListDisplay;
procedure RefreshImage(const ClientDNS, ImageName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
Clients: TThreadList;
implementation
{$R *.dfm}
procedure TForm1.RefreshImage(const ClientDNS, ImageName : string);
begin
Image1.Picture.LoadFromFile(ImageName);
StatusBar1.SimpleText := 'Snimek obrazovky z: ' + ClientDNS;
end;
procedure TForm1.RefreshListDisplay;
var
AClient :PClient;
i:integer;
begin
Button1.Enabled := False;
ListBox1.Clear;
with Clients.LockList do
try
for i := 0 to Count-1 do
begin
AClient := Items[i];
ListBox1.AddItem(AClient.HostName, TObject(AClient));
end;
finally
Clients.UnlockList;
end;
Button1.Enabled := ListBox1.Items.Count > 0;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
NewClient.PeerIP := AThread.Connection.Socket.Binding.PeerIP;
NewClient.HostName := GStack.WSGetHostByAddr(NewClient.PeerIP);
NewClient.TakeShot := False;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AThread;
AThread.Data := TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;
RefreshListDisplay;
end;
pokracovanie dalej...
LAZARUS priklad na indy10
Pre pridávanie komentárov sa musíte prihlásiť.
var
Client: PClient;
Command: string;
Size: integer;
PicturePathName: string;
ftmpStream: TFileStream;
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
Client := PClient(AThread.Data);
Client.LastAction := Now;
Command := AThread.Connection.ReadLn;
if Command = 'Kontrola' then
begin
if Client.TakeShot = True then
begin
Client.TakeShot := False;
AThread.Connection.WriteLn('Snimek');
PicturePathName := ExtractFileDir(ParamStr(0)) + '\' + Client.HostName + '_Screen.JPG';
if FileExists (PicturePathName) then DeleteFile(PicturePathName);
ftmpStream := TFileStream.Create(PicturePathName, fmCreate);
Size := AThread.Connection.ReadInteger;
AThread.Connection.ReadStream(fTmpStream, Size, False);
FreeAndNil(fTmpStream);
AThread.Connection.WriteLn('Hotovo');
RefreshImage(Client.HostName, PicturePathName);
end
else
AThread.Connection.WriteLn('Hotovo');
end;
end;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var
Client: PClient;
begin
Client := PClient(AThread.Data);
try
Clients.LockList.Remove(Client);
finally
Clients.UnlockList;
end;
FreeMem(Client);
AThread.Data := nil;
RefreshListDisplay;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
Clients.Duplicates := dupAccept;
StatusBar1.SimpleText := 'Èekám...';
RefreshListDisplay;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
ClientsCount: integer;
begin
try
ClientsCount := Clients.LockList.Count;
finally
Clients.UnlockList;
end;
if (ClientsCount > 0) then
begin
Action := caNone;
ShowMessage('Nejsou ukonèena vechna pøipojení!');
end
else
begin
IdTCPServer1.Active := False;
Clients.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SelClient : PClient;
begin
if ListBox1.ItemIndex = -1 then
begin
if Sender is TButton then ShowMessage('Zvolte nìkterého z pøipojených klientù!');
Exit;
end;
try
SelClient := PClient(Clients.LockList.Items[ListBox1.ItemIndex]);
SelClient.TakeShot := True;
finally
Clients.UnLockList
end;
end;
end.
tucne zvyrazneny kod mi vsak pri preklade hlasi nasledujucu chybu v lazaruse:
unit1.pas(66,32) Error: Illegal qualifier
unit1.pas(66,32) Hint: may be pointer dereference is missing
unit1.pas(66,32) Fatal: Syntax error, ")" expected but "identifier HOSTNAME" found
V com moze byt problem?
Dakujem za pomoc
Nápoveda Hint: may be pointer dereference is missing tomu nasvedčuje.
klobuk dole pred tebou clovece zatial na co som sa tu pytal vzdy si mi vedel poradit a neni tomu ani teraz inak ;)
diky za radu
este pre tych co sa stretnu s rovnakym problem, spravny zapis ma byt takto:
ListBox1.AddItem(AClient^.HostName, TObject(AClient));