В примера, поставляемых с Delphi, есть пример чата, я взял оттуда только примеры с сокетами, а все остальное переписал сам. Установил, старые, добрые TClientSocket, TServerSocet, Этот пример модуля для формы, в которой выбираешь локальный комп. | Код |
unit Net;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Buttons, ImgList;
type
TNetForm = class(TForm)
ListView1: TListView;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ImageList1: TImageList;
Label1: TLabel;
procedure FormShow(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Function FillNetLevel(xxx: PNetResource; list: TListItems) : Word;
function GetComputer:String;
end;
var
NetForm: TNetForm;
implementation
{$R *.DFM}
function TNetForm.FillNetLevel(xxx: PNetResource; List:TListItems): Word;
Type
PNRArr = ^TNRArr;
TNRArr = array[0..59] of TNetResource;
Var
x: PNRArr;
tnr: TNetResource;
I : integer;
EntrReq,
SizeReq,
twx: THandle;
WSName: string;
LI:TListItem;
begin
Result :=WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER, xxx, twx);
If Result = ERROR_NO_NETWORK Then Exit;
if Result = NO_ERROR then
begin
New(x);
EntrReq := 1;
SizeReq := SizeOf(TNetResource)*59;
while (twx <> 0) and
(WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
begin
For i := 0 To EntrReq - 1 do
begin
Move(x^[i], tnr, SizeOf(tnr));
case tnr.dwDisplayType of
RESOURCEDISPLAYTYPE_SERVER:
begin
if tnr.lpRemoteName <> '' then
WSName:= tnr.lpRemoteName
else WSName:= tnr.lpComment;
LI:=list.Add;
LI.Caption:=copy(WSName,3,length(WSName)-2);
//list.Add(WSName);
end;
else FillNetLevel(@tnr, list);
end;
end;
end;
Dispose(x);
WNetCloseEnum(twx);
end;
end;
procedure TNetForm.FormShow(Sender: TObject);
begin
ListView1.Items.Clear;
FillNetLevel(nil,ListView1.Items);
end;
function TNetForm.GetComputer: String;
begin
result:='';
if (ShowModal=mrok)and(ListView1.Selected<>nil) then result:=ListView1.Selected.Caption;
end;
procedure TNetForm.BitBtn2Click(Sender: TObject);
begin
ModalResult:=mrcancel;
end;
procedure TNetForm.BitBtn1Click(Sender: TObject);
begin
modalresult:=mrok;
end;
procedure TNetForm.ListView1DblClick(Sender: TObject);
begin
modalresult:=mrok;
end;
end.
|
Пример использования - нажимаем кнопку sbCopms на главной форме,показываем форму выбора компа, выбираем в листбоксе комп, нажимаем Ок | Код |
procedure TMainForm.sbCopmsClick(Sender: TObject);
begin
edit1.Text:=NetForm.GetComputer;
end;
|
Код кнопки отправить ForSend - глобальная переменная типа String | Код |
ForSend:=Memo1.Lines.Text;
ClientSocket1.Close;
ClientSocket1.Host:=edit1.Text;
ClientSocket1.Open;
|
Код компонента TServerSocket - OnClientRead memo2 - компонента TRichEdit | Код |
procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
vResText :String;
L :Integer;
begin
//получение текста
//если первый символ равен !, тогда выполняем файл
vResText:=socket.ReceiveText;
begin
memo2.Lines.Add('>---ПОЛУЧЕНО СООБЩЕНИЕ ОТ: '+socket.RemoteHost+'---');
L:=Length(Memo2.Text);
memo2.SelStart:=Length(Memo2.Text);
memo2.SelAttributes.Color:=clRed;
memo2.Lines.Add('>'+vResText);
memo2.SelLength:=L+Length(Memo2.Text);
memo2.Lines.Add('>---КОНЕЦ СООБЩЕНИЯ-------');
if not MainForm.Showing then MainForm.Show;
if MainForm.WindowState=wsMinimized then
application.Restore;
SetForeGroundWindow(Application.MainForm.Handle);
Memo1.SetFocus;
if vSound then begin
Windows.Beep(1000,100);
Windows.Beep(1200,100);
Windows.Beep(1300,100);
Windows.Beep(1400,100);
Windows.Beep(1300,100);
Windows.Beep(1200,100);
Windows.Beep(1100,100);
Windows.Beep(1000,100);
end;//if cbSound.Checked then begin
end;//else
end;
|
Для отсылания текста | Код |
procedure TMainForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
socket.SendText(ForSend);
// ForSend:='';
end;
|
В случае ошибки | Код |
procedure TMainForm.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
showmessage('Невозможно отправить сообщение!'+#13+
'Возможно программа не запущена на другом компьютере!'+#13+
'Сообщение будет сохранено на удаленном комппьютере'+#13+
'и будет прочтено при запуске программы.');
end;
|
Добавлено @ 17:38 Если будет что не понятно справшивай |
Чат в локальной сети, Как сделать программу, для чата в л.с. 
Загрузка ...
