Delphi und Net Send
lima-city → Forum → Programmiersprachen → Delphi & Pascal
all
binding
client
command
computer
connection
count
dns
exit
funktion
item
message
methode
not
ordner
po
send
sender
tutorial
window
-
Hallo,
ich habe zwei computer mit einem WLAN Netzwerk vernetzt, ich kann zwar mit der Eingeabeaufforderung Nachrichten an den anderen PC senden, will es aber Benutzerfreundlicher haben. Gibt es in Delphi eine m?glichkeit Nachrichten an andere Computer zu senden? Wenn ja, wie? Achja, man soll vorher in einem Edit den Text eingeben k?nnen...
-
Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!
lima-city: Gratis werbefreier Webspace für deine eigene Homepage
-
Das geht relativ einfach, indem du die Funktion NetMessageBufferSend aus der Netapi32.dll (im Verzeichnis %SystemRoot%\system32) verwendest.
Geht allerdings nur, wenn der Arbeitsstationsdienst l?uft (auf beiden Rechnern). Im Zweifelsfall mit den Windows-Bordmitteln mal ausprobieren.
Nachtrag:
Da es von der Kommandozeile aus geht, brauchst du da nichts mehr zu ?berpr?fen. Einfach nur die Funktion in dein Programm einbinden. -
THX @ 0-Checka, ist zwar f?r mich Delphi-anf?nger ein bisschen unverst?ndlich, aber es gibt ja sowas wie probieren :-) Achja, wie ist eigentlich die Syntax?
@ttobsen Wie funktioniert das denn? -
h? ?? keine ahung und nix mitkomm.. ich w?rds mit net send machen oder unter widows xp mit winchat!
-
THX @ ttobsen, nur eine Frage, welche parameter m?ssen da denn rein? (Ich hab ne while schleife, da der Benutzer vorher eingeben kann wie oft gesendet werden soll^^ und da soll dann die funktion aufgerufen werden.)
also so hab ich jetzt die Proceduren(While und Send^^):
procedure NetMessageBufferSend(an, text); external 'c:\windows\system32\Netapi32.dll';
begin
end;
procedure TForm1.Button1Click(Sender: TObject);
var i, oft: integer;
text, an: String;
begin
oft := StrToInt(wieoft.Text);
i:=1;
text := textsend.Text;
an := anwen.Text;
while i<=oft DO
begin
NetMessageBufferSend(an, text);
i:=i+1;
end;
end;
Und wie funktioniert das direkt ?ber TCP/IP? Das mit ""ShellExecute(Handle, 'open', 'c:\Windows\System32\net.exe', 'send * test', nil, SW_HIDE); "" ?ffnet ja das Windows Net.exe mit den send paramtern, aber ich will ja auch andere Methoden zum senden lernen^^
-
THX @ ttobsen, habs hingekrigt, hab nen chat gemacht, und einen normalen net sender (f?r alerts xD)
von mir aus kann das hier geclost werden^^ -
Hier ein Chat^^ (Nach einem Tutorial nachgemacht, aber selber getippt^^):
http://vercetti.xardas.lima-city.de/Delphi/
(Netchat server und client, das mit den alerts muss ich noch packen, werds dann aber mit in den ordner tun, unter alert^^)
//EDIT: Alert tu ich erst noch nicht rein, wenn man was falsches eingibt kommt gleich eine fette meldung (z.B anstatt Zahl ein Buchstabe)
-
EXE Dateien sind VERBOTEN!!!
achja wie w?rs wenn du einfach intrasent nimmst??
is viel einfacher ;) -
Ich habs ja als 7Zip oder so gespeichert....
//EDIT: Ist mit Iexpress aus winxp gemacht (extrahierbares archiv oder so, da kann man ordner angeben wo hinsoll) -
das sind so viele
, ich kopier mal den ganzen Code dingsda aus delphi hier rein(wirklich alles xD):
Client:
unit MainForm;
interface
uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls,
Menus, Buttons, Spin, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
edUserName: TEdit;
Label2: TLabel;
edServer: TEdit;
Label3: TLabel;
lbClients: TListBox;
Label4: TLabel;
memLines: TMemo;
Label5: TLabel;
edMessage: TEdit;
SpeedButton1: TSpeedButton;
IdTCPClient1: TIdTCPClient;
Timer1: TTimer;
Label6: TLabel;
sePort: TSpinEdit;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure edMessageKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormShow(Sender: TObject);
begin
width := width + 1;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Com,
Msg : String;
begin
if not IdTcpClient1.Connected then
exit;
Msg := IdTCPClient1.ReadLn('', 5);
if Msg <> '' then
if Msg[1] <> '@' then
begin
{ Not a system command }
memLines.Lines.Add(Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
lbClients.Items.CommaText := Msg;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if (edUserName.Text <> '') and
(edServer.Text <> '') and
SpeedButton1.Down then
begin
IdTCPClient1.Host := edServer.Text;
IdTCPClient1.Port := sePort.Value;
if SpeedButton1.Down then
IdTCPClient1.Connect;
end
else
begin
if (edUserName.Text = '') or
(edServer.Text = '') then
ShowMessage('You must put in a User Name and server name to connect.');
SpeedButton1.Down := false;
end;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.WriteLn(edUserName.Text);
end;
procedure TForm1.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
IdTCPClient1.WriteLn(edMessage.Text);
edMessage.Text := '';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.WriteLn('@' + 'CLIENTS:REQUEST');
end;
end.
Server:
unit MainForm;
interface
uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault;
type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end;
TfrmMain = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
lbClients: TListBox;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ImageList1: TImageList;
Label3: TLabel;
lblDNS: TLabel;
tcpServer: TIdTCPServer;
lblSocketVer: TLabel;
Label5: TLabel;
Label4: TLabel;
seBinding: TSpinEdit;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Label6: TLabel;
Label7: TLabel;
memEMotes: TMemo;
Label8: TLabel;
Label9: TLabel;
lblClientName: TLabel;
lblClientDNS: TLabel;
puMemoMenu: TPopupMenu;
Savetofile1: TMenuItem;
Loadfromfile1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
btnServerUp: TToolButton;
ToolButton1: TToolButton;
btnKillClient: TToolButton;
btnClients: TToolButton;
btnPM: TToolButton;
Label12: TLabel;
edSyopName: TEdit;
Willkommen: TRichEdit;
procedure btnServerUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seBindingChange(Sender: TObject);
procedure tcpServerConnect(AThread: TIdPeerThread);
procedure tcpServerDisconnect(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Savetofile1Click(Sender: TObject);
procedure Loadfromfile1Click(Sender: TObject);
procedure tcpServerExecute(AThread: TIdPeerThread);
procedure btnClientsClick(Sender: TObject);
procedure btnPMClick(Sender: TObject);
procedure btnKillClientClick(Sender: TObject);
procedure lbClientsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Clients : TList;
procedure UpdateBindings;
procedure UpdateClientList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
uses
IdSocketHandle; // This is where the IdSocketHandle class is defined.
procedure TfrmMain.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
{ Set the TIdTCPServer's port to the chosen value }
tcpServer.DefaultPort := seBinding.Value;
{ Remove all bindings that currently exist }
tcpServer.Bindings.Clear;
{ Create a new binding }
Binding := tcpServer.Bindings.Add;
{ Assign that bindings port to our new port }
Binding.Port := seBinding.Value;
end;
procedure TfrmMain.btnServerUpClick(Sender: TObject);
begin
try
{ Check to see if the server is online or offline }
tcpServer.Active := not tcpServer.Active;
btnServerUp.Down := tcpServer.Active;
if btnServerUp.Down then
begin
{ Server is online }
btnServerUp.ImageIndex := 1;
btnServerUp.Hint := 'Shut down server';
end
else
begin
{ Server is offline }
btnServerUp.ImageIndex := 0;
btnServerUp.Hint := 'Start up server';
end;
{ Setup GUI buttons }
btnClients.Enabled:= btnServerUp.Down;
seBinding.Enabled := not btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
except
{ If we have a problem then rest things }
btnServerUp.Down := false;
seBinding.Enabled := not btnServerUp.Down;
btnClients.Enabled:= btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ Initalize our clients list }
Clients := TList.Create;
{ Call updatebindings so that the servers bindings are correct }
UpdateBindings;
{ Get the local DNS entry for this computer }
lblDNS.Caption := tcpServer.LocalName;
{ Display the current version of indy running on the system }
lblSocketVer.Caption := tcpServer.Version;
end;
procedure TfrmMain.seBindingChange(Sender: TObject);
begin
UpdateBindings;
end;
procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Send a welcome message, and prompt for the users name }
AThread.Connection.WriteLn('ISD Connection Established...');
AThread.Connection.WriteLn('Please send valid login sequence...');
AThread.Connection.WriteLn('Your Name:');
{ Create a client object }
Client := TSimpleClient.Create;
{ Assign its default values }
Client.DNS := AThread.Connection.LocalName;
Client.Name := 'Logging In';
Client.ListLink := lbClients.Items.Count;
{ Assign the thread to it for ease in finding }
Client.Thread := AThread;
{ Add to our clients list box }
lbClients.Items.Add(Client.Name);
{ Assign it to the thread so we can identify it later }
AThread.Data := Client;
{ Add it to the clients list }
Clients.Add(Client);
end;
procedure TfrmMain.tcpServerDisconnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }
Client := Pointer(AThread.Data);
{ Remove Client from the Clients TList }
Clients.Delete(Client.ListLink);
{ Remove Client from the Clients List Box }
lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
BroadcastMessage('System', Client.Name + ' has left the chat.');
{ Free the Client object }
Client.Free;
AThread.Data := nil;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Clients.Count > 0) and
(tcpServer.Active) then
begin
Action := caNone;
ShowMessage('Can''t close CBServ while server is online.');
end
else
Clients.Free;
end;
procedure TfrmMain.Savetofile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit;
if SaveDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TfrmMain.Loadfromfile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit;
if OpenDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;
procedure TfrmMain.UpdateClientList;
var
Count : Integer;
begin
{ Loop through all the clients connected to the system and set their names }
for Count := 0 to lbClients.Items.Count -1 do
if Count < Clients.Count then
lbClients.Items.Strings[Count] := TSimpleClient(Clients.Items[Count]).Name;
end;
procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
var
Client : TSimpleClient;
Com, // System command
Msg : String;
begin
{ Get the text sent from the client }
Msg := AThread.Connection.ReadLn;
{ Get the clients package info }
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }
if Client.Name = 'Logging In' then
begin
{ if not, assign the name and announce the client }
Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Msg + ' has just logged in.');
AThread.Connection.WriteLn(willkommen.Lines.Text);
end
else
{ If name is set, then send the message }
if Msg[1] <> '@' then
begin
{ Not a system command }
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
AThread.Connection.WriteLn( '@' + 'clients:' +
lbClients.Items.CommaText);
end;
end;
procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage);
EMote := Trim(memEMotes.Lines.Values[Msg]);
if WhoFrom <> 'System' then
Msg := WhoFrom + ': ' + Msg;
if EMote <> '' then
Msg := Format(Trim(EMote), [WhoFrom]);
List := tcpServer.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
tcpServer.Threads.UnlockList;
end;
end;
procedure TfrmMain.btnClientsClick(Sender: TObject);
begin
UpdateClientList;
end;
procedure TfrmMain.btnPMClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Private Message', 'What is the message', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;
procedure TfrmMain.btnKillClientClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(lbClients.ItemIndex);
lbClients.Items.Delete(lbClients.ItemIndex);
end;
end;
procedure TfrmMain.lbClientsClick(Sender: TObject);
var
Client : TSimpleClient;
begin
btnPM.Enabled := lbClients.ItemIndex <> -1;
btnKillClient.Enabled := btnPM.Enabled;
if lbClients.ItemIndex = -1 then
exit;
Client := Clients.Items[lbClients.ItemIndex];
lblClientName.Caption := Client.Name;
lblClientDNS.Caption := Client.DNS;
end;
end.
Danke an ein Tutorial bei www.delphi-source.de
-
?hm ja XD
ich hab nen prob mit dem server und clienten
der client schmirt andauernt ab, nachdem eine verbindung zum server hergestellt wurde!
also er macht nichts mehr, ich muss ihn dann per alt+f4 oder ?bern taskmanager beenden -
?hm ja XD
ich hab nen prob mit dem server und clienten
der client schmirt andauernt ab, nachdem eine verbindung zum server hergestellt wurde!
also er macht nichts mehr, ich muss ihn dann per alt+f4 oder ?bern taskmanager beenden
Bei meinen zwei rechnern funktioniert alles problemlos, vielleicht beim client ne firewall die den Port blockt oder so?^^ -
das l?uft ?bern gleichen pc...
ausserdem verzichte ich auf sowas wie firewall (und virenscanner ;))
wenn ich nen virus krieg hat der viel (sehr viel) zu tun :)
und dann muss er noch die system partition finden, die liegt auf H: XD
ich hab win xp falls dus brauchst
aber der client st?rtz halt komplett ab.. -.- -
das l?uft ?bern gleichen pc...
ausserdem verzichte ich auf sowas wie firewall (und virenscanner ;))
wenn ich nen virus krieg hat der viel (sehr viel) zu tun :)
und dann muss er noch die system partition finden, die liegt auf H: XD
ich hab win xp falls dus brauchst
aber der client st?rtz halt komplett ab.. -.-
habs auch mal auf einem computer getestet, der st?rtzt bei mir auch ab, kA woran das liegt, winXP hab ich auch.... -
ich kann kein delphi, aber k?nnte es vllt an ner schleife liegen?
auf jeden fall st?rtzt der client erst nach erflogreichem verbindungsaufbau ab
ich hoff, dass du den bug noch findest ;)
is sonst ganz gut das prog :) -
Soa folgendes ^^
#####
unit NetSendMain;
interface
uses
SysUtils, Classes, Controls, Forms, StdCtrls, Dialogs, ncxNetSend;
type
TMainForm = class(TForm)
EditName: TEdit;
MemoBuffer: TMemo;
ButtonSend: TButton;
ButtonExit: TButton;
procedure ButtonSendClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.ButtonSendClick(Sender: TObject);
begin
ButtonSend.Enabled := False;
try
ShowMessage(SysErrorMessage(NetSend(EditName.Text, MemoBuffer.Text)));
finally
ButtonSend.Enabled := True;
end;
end;
procedure TMainForm.ButtonExitClick(Sender: TObject);
begin
Close;
end;
end.
####
program NetSend;
uses
Forms,
NetSendMain in 'NetSendMain.pas' {MainForm};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end. -
Und wie kann man jetzt direkt ?ber TCP/IP eine Message oder so verschicken, habe schon ?ber all gegooglet aber finde nix und geht dass auch ?bder DOS (BATCHDATEI) oder nur mit DELPHI/Turbo Pascal???
Hoffe auf HILFE!!! -
Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!
lima-city: Gratis werbefreier Webspace für deine eigene Homepage
