[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
  1. Exile1985

    Exile1985 Elder - Старейшина

    Joined:
    10 Aug 2006
    Messages:
    124
    Likes Received:
    35
    Reputations:
    1
    Code:
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
      IdMessageClient, IdSMTP, StdCtrls, idMessage, IdEMailAddress;
    
    ...
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      M: TIdMessage;
    begin
      M := TIdMessage.Create(Form1);
      with M do 
    begin
      Body.Add('Типа первая строчка собщения');
      From.Text := '"Рустик" <[email protected]>'; //отправитель
      Recipients.Add;
      Recipients.Items[0].Text := '"Тест" <[email protected]>'; //Получатель
      Subject := 'Тема письма'; //Тема письма
      TIdAttachmentFile.Create(M.MessageParts,   OpenDialog1.FileName);//крепим файл
    end;
    
    with IdSMTP1 do 
    begin 
      //авторизация
     AuthenticationType := atLogin; 
     Host := 'uacity.com'; //хост
     Username := 'boris'; // логин
     Password := '1234'; // пасс
     Connect();
    end;
      if IdSMTP1.Connected then
      begin
        IdSMTP1.Send(M);
      end;
      IdSMTP1.Disconnect;
    end;
    подавись :)
     
  2. Xserg

    Xserg Elder - Старейшина

    Joined:
    9 Dec 2006
    Messages:
    135
    Likes Received:
    127
    Reputations:
    53
    Как-то так?
    Code:
    function SetConsoleDisplayMode(hOut:THandle;dwNewMode:DWORD;lpdwOldMode:pointer):BOOL;
      stdcall; external 'kernel32.dll' name 'SetConsoleDisplayMode';
    var
      smdWND:dword=0;
      I,DC:dword;
      P : array [0..3] of TPoint;
      pi: TProcessInformation;
      si: TStartupInfo;
      s:string;
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      AllocConsole();
      ZeroMemory(@si, SizeOf(TStartupInfo));
      si.cb := SizeOf(TStartupInfo);
      CreateProcess(nil,PChar('cmd.exe'), // command line
        nil,nil,TRUE,0,nil,nil,
        si,pi);
    setlength(S,256);
    setlength(S,GetConsoleTitle(@S[1],256));
    SetConsoleTitle('AA_BB_CC_DD');
    smdWND:=FindWindow(0,'AA_BB_CC_DD');
    SetConsoleTitle(PansiChar(S));
    //Делаем не на полный экран
    SetConsoleDisplayMode(GetStdHandle(STD_OUTPUT_HANDLE),0,@I);
    P[0] := Point(     5,23);
    P[1] := Point(500-15,23);
    P[2] := Point(500-15,200-5);
    P[3] := Point(     5,200-5);
    //Вырезаем лишнее
    SetWindowRgn(smdWND,CreatePolygonRgn(P,4,Alternate),true);
    SetWindowPos(smdWND,HWND_TOPMOST,form1.left,form1.Top+200,700,200,SWP_SHOWWINDOW);
    end;
    procedure TForm1.FormConstrainedResize(Sender: TObject; var MinWidth,
      MinHeight, MaxWidth, MaxHeight: Integer);
    begin
    if smdWND<>0 then
    MoveWindow(smdWND,form1.left,form1.Top+200,700,200,true);
    end;
    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    if smdWND<>0 then begin
    Terminateprocess(pi.hProcess,0);
    FreeConsole();smdWND:=0;
                      end;
    end;
    
     
  3. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    нефигасе, этот код, лучьшый что я видел в инете, глаза открой, там авторизация есть )
     
  4. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Блин, что же за напасть такая :(. Не могу из-под делфни апачи запустить! Уже ипусь полчаса, перепробовал:

    Code:
    var
      ApacheProcInfo: TProcessInformation;
      ApacheStart: TStartupInfo;
    ...
         CreateProcess(pchar('K:\prakt\apache\bin\Apache.exe'),nil,nil,nil,false,0,nil,nil,ApacheStart,ApacheProcInfo);
    Code:
    winexec('start K:\prakt\apache\bin\Apache.exe',sw_show);
    Code:
    winexec('K:\prakt\apache\bin\Apache.exe',sw_show);
    Code:
    ShellExecute(application.handle,nil,'K:\prakt\apache\bin\Apache.exe',nil,nil,sw_show);
    Во всех случаях либо ничего не происходит, либо окно мелькает и все. Так работает:
    Code:
    @echo off
    K:
    cd \prakt\apache\bin
    start Apache.exe
    Что за фигня?
     
    1 person likes this.
  5. Xserg

    Xserg Elder - Старейшина

    Joined:
    9 Dec 2006
    Messages:
    135
    Likes Received:
    127
    Reputations:
    53
    Явно не хватает :
    SetCurrentDir('K:\prakt\apache\bin\');
     
  6. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    Joker-jar Явно не хватает ключей запуска "-k start" :)

    ShellExecute(application.handle,'open','K:\prakt\apac he\bin\Apache.exe','-k start',nil,sw_show);

    P.S. Но может версии не совпадать, у меня Apache_Swissknife.exe 3.0.0
     
    #566 GlOFF, 1 Sep 2007
    Last edited: 1 Sep 2007
    1 person likes this.
  7. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Блин, вроде разобрался, но появилась другая проблема. При запуске Apache запускается вторая копия. Когда убиваю процесс, второй так и остается висеть. Видать, это дочерний первого Apache.exe. Создаю процесс так:
    Code:
    var
      ApacheProcInfo: TProcessInformation;
      ApacheStart: TStartupInfo;
    ...
      ApacheStart.cb := sizeof(ApacheStart);
      ApacheStart.dwFlags := STARTF_USESHOWWINDOW;
      ApacheStart.wShowWindow := SW_HIDE;
      CreateProcess(pchar('K:\prakt\apache\bin\Apache.exe'),nil,nil,nil,false,0,nil,nil,ApacheStart,ApacheProcInfo);
    Потом убиваю:
    Code:
      TerminateProcess(ApacheProcInfo.hProcess, 0);
    Как вместе с убиваемым процессом снести все его дочерние процессы?
     
  8. da_ff

    da_ff Elder - Старейшина

    Joined:
    11 Jul 2006
    Messages:
    118
    Likes Received:
    22
    Reputations:
    26
    2 Joker-jar
    однако, апач это все же сервер.
    ты б хоть посмотрл на строки команды инициализации
    restart - Apache.exe -w -n "Apache2" -k restart
    stop - Apache.exe -w -n "Apache2" -k stop
    start - Apache.exe -w -n "Apache2" -k start
    это в винде
     
    1 person likes this.
  9. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    da_ff прав ->
    ShellExecute(application.handle,'open','K:\prakt\a pac he\bin\Apache.exe','-k stop',nil,sw_show);

    Joker-jar Это чтобы остановить сервер!
     
  10. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Я все это уже перепробовал. Все равно почему-то запускается 2 копии :(
     
    1 person likes this.
  11. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Короче, останавливаю свой сервачок банальным киллом всех задач Apache.exe и mysqld.exe. Тупо, но работает. Мне главное практику сдать, так что на красоту забил. Всем спасибо кто помогал ;)
     
  12. infernal-team

    infernal-team Elder - Старейшина

    Joined:
    4 Jul 2007
    Messages:
    53
    Likes Received:
    17
    Reputations:
    -10
    Exile1985 это вообще что такое? with IdSMTP1 do
     
    1 person likes this.
  13. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Это синтаксис. Способ обращения к методам/атрибутам и т.д. какого-либо объекта. В данном случае IdSMTP1
     
    1 person likes this.
  14. _Great_

    _Great_ Elder - Старейшина

    Joined:
    27 Dec 2005
    Messages:
    2,032
    Likes Received:
    1,119
    Reputations:
    1,139
    Не надо постить тут откровенную тупость. Учебник читать иногда бывает полезно.
     
  15. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    Code:
     это вообще что такое? with IdSMTP1 do
    Да ЖЕСТОКИЙ МИР (С) !!! infernal-team Простенький учебничек не помешал!
    with IdSMTP1 do - типо с объектом IdSMTP1 делать следующее... например щас поймешь разницу
    1) Применяя данную инструкцую
    Code:
    with IdSMTP1 do 
    begin 
      //авторизация
     AuthenticationType := atLogin; 
     Host := 'uacity.com'; //хост
     Username := 'boris'; // логин
     Password := '1234'; // пасс
     Connect();
    end;
    
    2) Не используя
    Code:
    begin 
      //авторизация
     IdSMTP1.AuthenticationType := atLogin; 
     IdSMTP1.Host := 'uacity.com'; //хост
     IdSMTP1.Username := 'boris'; // логин
     IdSMTP1.Password := '1234'; // пасс
     IdSMTP1.Connect();
    end;
    
    Зачем это нужно? сократить "писанину"...
    infernal-team Все же почитай БИБЛИЯ ДЕЛФИ - МИХАИЛ ФЛЕНОВ, к примеру!

    _Great_ Ну а для чего же тогда тема создана :confused: Ведь чтобы спрашивать, а уровень у каждого свой...
     
    1 person likes this.
  16. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Без обид, но порвало )
    Учебник, тебе не помешал бы )
     
    #576 z01b, 4 Sep 2007
    Last edited: 4 Sep 2007
    1 person likes this.
  17. alamat

    alamat Elder - Старейшина

    Joined:
    6 Aug 2007
    Messages:
    18
    Likes Received:
    3
    Reputations:
    0
    Здравствуйте! Небольшая(а может очень большая) проблема, мне надо подключаться через Proxy сервер к smtp серверу при помощи компанента idsmtp. Подскажите как я могу это сделать?
     
  18. 5p4x2kn3t

    5p4x2kn3t New Member

    Joined:
    6 Sep 2007
    Messages:
    8
    Likes Received:
    0
    Reputations:
    0
    Пытаюсь в своей программе получить HTML-код Web-страницы с помощью WinSock API, но программа элементарно виснет (если есть связь с Интернетом) я неправильно пользуюсь сокетами или HTTP-протоколом?

    P.S. Antichat почему-то на месте многих пробелов ставит *

    Code:
    procedure Get;
      var
       k : integer;
      * Servername  : string;
    
    * * FSocket* * : integer;
    * * HostEnt* * : PHostEnt;
    * * SockAddrIn : TSockAddrIn;
    * * dSize* * * : dword;
    * * Str* * * * : array [0..255] of Char;
    * * WSAData* * : TWSAData;
    begin
    
    //...
    * WSAStartup(257, WSAData);* 
    * * if Pos('http://', fUrl) = 0 then
    * * * fUrl* *:= 'http://' + fUrl;
    
    * Servername := AnsiReplaceStr(fUrl, 'http://', '');
    
    * * FOR k := 1 TO length(Servername) DO
    * * * if Servername[k] = '/' then
    * * * * begin
    * * * * * Servername := copy(Servername, 1, k - 1);
    * * * * * break;
    * * * * end;
    
    * FSocket* * * * * * * * * * := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
    * SockAddrIn.sin_family* * * := AF_INET;
    * SockAddrIn.sin_port* * * * := htons(80);
    * SockAddrIn.sin_addr.s_addr := inet_addr(PAnsiChar(Servername));
    * * if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
    * * * begin
    * * * * HostEnt := gethostbyname(PAnsiChar(Servername));
    * * * * * if HostEnt = nil then
    * * * * * * begin
    * * * * * * * closesocket(FSocket);
    * * * * * * * Exit;
    * * * * * * end;
    * * * * SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^;
    * * * end;
    * * if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then
    * * * begin
    * * * * lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
    * * * * Str := '';
    * * * * send(FSocket, Str, lstrlen(Str), 0);
    * * * * * repeat
    * * * * * * dSize := recv(FSocket, Str, 255, 0);
    * * * * * * Code.AddString(Str);
    //Code - аналог TStringList
    * * * * * until
    * * * * * * (dSize = 0) or (dSize = SOCKET_ERROR);
    * * * * closesocket(FSocket);
    * * * end;
    * WSACleanup();
    //...
    end;
    
     
  19. NetMan

    NetMan Elder - Старейшина

    Joined:
    9 Feb 2004
    Messages:
    121
    Likes Received:
    37
    Reputations:
    34
    5p4x2kn3t > попробуй продебажить =)
    Заметил только что здесь:
    Code:
    lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
    не совсем правильно...
    Надо:
    Code:
    lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#13#10));
     
    #579 NetMan, 7 Sep 2007
    Last edited: 7 Sep 2007
  20. 5p4x2kn3t

    5p4x2kn3t New Member

    Joined:
    6 Sep 2007
    Messages:
    8
    Likes Received:
    0
    Reputations:
    0
    Все равно не помогает.

    Да, у меня в программе много потоков(TThread), использующих сокеты, инициализацию WSA нужно делать только в главной части
    (еще перед созданием первого потока - каждый поток порождает новые) или в каждом?

    Насчет запуска в debug-режиме - последняя остановка - на recv, дальше поток виснет, причем непонятно где, кажется в цикле repeat, но хз...
     
    #580 5p4x2kn3t, 7 Sep 2007
    Last edited: 7 Sep 2007
Thread Status:
Not open for further replies.