[ 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. <Zodiac>

    <Zodiac> New Member

    Joined:
    20 Oct 2007
    Messages:
    5
    Likes Received:
    0
    Reputations:
    0
    Помогите с отправкой письма!

    Проблема состоит не в шифровке данных с помощью base64. Нужен код на отправку письма с аттачментом через WinSock. Те примеры, что в инете валяются не работают :(

    Вот вариант, который я использую. Посмотрите пожалуйста и скажите в чем трабл (как сделать так, чтобы Pupkin2 остался довольным :) ):

    Code:
    uses WinSock
    
    ....
    
    function LookupName(host: string): TInAddr;
    var
      HostEnt: PHostEnt;
      InAddr: TInAddr;
    begin
      HostEnt := gethostbyname(PChar(host));
      FillChar(InAddr, SizeOf(InAddr), 0);
      if HostEnt <> nil then
        begin
          with InAddr, HostEnt^ do
            begin
              S_un_b.s_b1 := h_addr^[0];
              S_un_b.s_b2 := h_addr^[1];
              S_un_b.s_b3 := h_addr^[2];
              S_un_b.s_b4 := h_addr^[3];
            end;
        end;
      Result := InAddr;
    end;
    
    function GetComputerNetName: string;
    var
      buffer: array[0..255] of char;
      size: dword;
    begin
      size := 256;
      if GetComputerName(buffer, size) then
        Result := buffer
      else
        Result := ''
    end;
    
    procedure SMTPSendString(MailSocket:TSocket;Str:string);
    var
      Buffer:Array[0..255] of char;
    begin
      StrPCopy(Buffer,Str);
      Send(MailSocket,Buffer,length(Str),0);
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      WSA:TWSAData;
      MailSocket:TSocket;
      SMTPServer:TSockAddr;
    begin
      WSAStartup(MAKEWORD(1,0),WSA);
      MailSocket:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP  );
      ZeroMemory(@SMTPServer,SizeOf(SMTPServer));
      SMTPServer.sin_family:=AF_INET;
      SMTPServer.sin_port:=htons(25);
      SMTPServer.sin_addr:=LookupName('smtp.mail.ru');
      if Connect(MailSocket,SMTPServer,SizeOf(SMTPServer))=  0 then
        begin
          SMTPSendString(mailsocket,'HELO '+ GetComputerNetName + CTRLF);
          SMTPSendString(mailsocket,'AUTH LOGIN ' + CTRLF + b64encode('[B][COLOR=Indigo]Pupkin1[/COLOR][/B]') + CTRLF + b64encode('[B][COLOR=Indigo]password[/COLOR][/B]') + CTRLF);
          SMTPSendString(mailsocket,'MAIL FROM:' + '[B][COLOR=Indigo]Pupkin1@mail.ru[/COLOR][/B]' + CTRLF + 'RCPT TO:' + '[B][COLOR=Yellow]Pupkin2@mail.ru[/COLOR][/B]' + CTRLF);
          SMTPSendString(mailsocket,'DATA' + CTRLF + 'From: "' + '[B][COLOR=Indigo]Pupkin1[/COLOR][/B]' + '" <' + '[B][COLOR=Indigo]Pupkin1@mail.ru[/COLOR][/B]' + '>' + CTRLF + 'To: "' + '[B][COLOR=Yellow]Pupkin2[/COLOR][/B]' + '" <' + '[B][COLOR=Yellow]Pupkin2@mail.ru[/COLOR][/B]' + '>' + CTRLF + 'Subject: ' + '[B]TESTING[/B]' + CTRLF);
          SMTPSendString(mailsocket,'[B][COLOR=Blue]DONE!!!![/COLOR][/B]'+CTRLF);
          SMTPSendString(mailsocket,CTRLF+'.'+CTRLF+CTRLF+'QUIT');
        end
      else
        ShowMessage('[COLOR=Red]ERROR[/COLOR]');
      CloseSocket(MailSocket);
      WSACleanup;
    end;
     
    #661 <Zodiac>, 22 Oct 2007
    Last edited: 23 Oct 2007
  2. t04

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

    Joined:
    10 Jan 2007
    Messages:
    137
    Likes Received:
    40
    Reputations:
    8
    ты что, хочешь чтобы тебе на тарелочке с голубой каемочкой функцию выложили? ты сам попотей, я как раз выложил ссылки не на готовое, а на теорию. там на асме как раз таки и не реализован аттач, но теоретически вроде все доходчиво. почитай, кодирование в бейс64 в двух последних ссылках.

    зы я кстати тоже асм не знаю и писал на делфи.

    зыы здорово выручил снифер для написания последних штрихов и связывания обрывков кода в единое целое.

    к стати, где то тут (на форуме) натыкался на модуль для отправки писем с аттачем, кажись в разделе с полезными модулями, попробуй поискать.
     
    #662 t04, 23 Oct 2007
    Last edited by a moderator: 26 Oct 2007
  3. <Zodiac>

    <Zodiac> New Member

    Joined:
    20 Oct 2007
    Messages:
    5
    Likes Received:
    0
    Reputations:
    0
    Я с тем, что ты мне дал на асме разобрался и как аттачмент отправить и все такое. Но мне нужно реализовать все на Delphi и никак не получается! Я те же самые коменды через telnet задовал - получается, а программно нет! Вот и прошу помочь! Может я где в сокетах ошибся?!
    Я итак юзаю все возможные варианты, и те полезные модули смотрел (то, что выше это я их упрощал). НЕ РАБОТАЕТ! :rolleyes:
     
    #663 <Zodiac>, 23 Oct 2007
    Last edited: 23 Oct 2007
  4. <Zodiac>

    <Zodiac> New Member

    Joined:
    20 Oct 2007
    Messages:
    5
    Likes Received:
    0
    Reputations:
    0
    Все сегодня сам разобрался со всем, теперь работает! Вопрос закрыт. t04, все равно спасибо за исходники асма, они чуть помогли:)
     
  5. GroM88

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

    Joined:
    24 Oct 2007
    Messages:
    461
    Likes Received:
    62
    Reputations:
    26
    Кароче ребята вопрос может не по теме ,но всётаки !!
    Может кто знает как можно лицензионный ключ узнать к программе ,возможно ли её перепрограмировать ?
    Просто когда я открываю программу она выбивает введите лицензионный ключ !!!
    А когда закрываю это окно то и программа полностью закрывается!
    ПРОСТО ключик к этой проге стоит оч много бабла!
     
  6. Killerkod

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

    Joined:
    1 Aug 2007
    Messages:
    178
    Likes Received:
    113
    Reputations:
    0
    Найди кряк или серийник... Гугль тебе в помощь!
     
  7. Exile1985

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

    Joined:
    10 Aug 2006
    Messages:
    124
    Likes Received:
    35
    Reputations:
    1
    Ты щас сам понял что написал???
    Ты попробуй подумать что нужно написать в посте если тебе нужен ключ от проги???

    отвечать на вапрос не буду так как он задан не корректно, нет названия проги к которой нужен ключ, сам подумай защита может любая стоять и никто тебе не че не скажет т.к. не на что отвечать.


    единственное..... на счет перепограммировать, дизасемблер тебе в руки, если тебе это о чем нить говорит.
     
  8. G1yuK

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

    Joined:
    25 May 2007
    Messages:
    41
    Likes Received:
    9
    Reputations:
    0
    GroM88 тебе в тему реверсинг надо, а не программирования
    http://forum.antichat.ru/forum94.html
     
  9. Inf

    Inf New Member

    Joined:
    28 Oct 2007
    Messages:
    2
    Likes Received:
    0
    Reputations:
    0
    Подскажите кто-нить нубу , как иконку добавить к программе? ы :)
     
  10. darckmilord

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

    Joined:
    8 Feb 2007
    Messages:
    50
    Likes Received:
    14
    Reputations:
    0
    Запускаешь Дельфи, нажимаешь Shift+Ctrl+F11 в появившемся окне переходишь на закладку Application нажимаешь кнопку Load Icon и выбираешь че те надо, потом жмешь окей.
     
    1 person likes this.
  11. darckmilord

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

    Joined:
    8 Feb 2007
    Messages:
    50
    Likes Received:
    14
    Reputations:
    0
    Помогите с ресурсами

    Доброго Всем времени суток. У меня такой вопрос, как с компилировать файл ресурсов с гиф анимациями. Как сделать тоже самое с бмп ико и другима стандартными для борланда я знаю а скомпилить гифы в файл ресурсов не могу.

    Теперь в качстве отступления объясню причину вставки. Это необходимо для вставки в RxRichEdit для этого пользуюсь таким кодом взятым с дельфисоурса

    Code:
    var      
      frmMain: TfrmMain;         
    
    implementation         
    
    {$R *.DFM}    
    {$R Smiley.res}         
    
    uses      RichEdit;
    
    type      TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;        cb: Longint; var pcb: Longint): DWORD;      stdcall;           
    
    TEditStream = record        dwCookie: Longint;        dwError: Longint;        pfnCallback: TEditStreamCallBack;      
    
    end;         
    
    type      TMyRichEdit = TRxRichEdit;         
    
    // EditStreamInCallback callback function          
    
    function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;      cb: Longint; var pcb: Longint): DWORD; stdcall;    
    
    var      
    
    theStream: TStream;      
    dataAvail: LongInt;    
    
    begin      
    
    theStream := TStream(dwCookie);      
      with theStream do
          begin        
             dataAvail := Size - Position;
             Result := 0;        
             if dataAvail <= cb then        
                     begin          
                         pcb := read(pbBuff^, dataAvail);          
                         if pcb <> dataAvail then            
                               Result := UINT(E_FAIL);        
                         end
                         else        
                             begin          
                                pcb := read(pbBuff^, cb);          
                                if pcb <> cb then
                                 Result := UINT(E_FAIL);
                             end;
                      end;    
    end;         
    
    // Insert Stream into RichEdit          
    
    procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);    
    
    var      
    
    EditStream: TEditStream;    
    
    begin      
      with EditStream do
        begin        
          dwCookie := Longint(SourceStream);        
          dwError := 0;
          pfnCallback := EditStreamInCallBack;
        end;
       RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
    end;
    
    // Load a smiley image from resource 
    
    function GetSmileyCode(ASimily: string): string;
    
    var      
    
    dHandle: THandle;
    pData, pTemp: PChar;
    Size: Longint;
    
    begin
    
    pData := nil;
    dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);
    if dHandle <> 0 then
      begin        Size := SizeofResource(hInstance, dHandle);        dhandle := LoadResource(hInstance, dHandle);
        if dHandle <> 0 then
        try
        pData := Resource(dHandle);
        if pData <> nil then
        try
        if pData[Size - 1] = #0 then
          begin
            Result := StrPas(pTemp);
          end
          else
              begin
              pTemp := StrAlloc(Size + 1);
              try
              StrMove(pTemp, pData, Size);
              pTemp[Size] := #0;
              Result := StrPas(pTemp);
              finally
              StrDispose(pTemp);
          end;
          end;
          finally
          UnlockResource(dHandle);
          end;
          finally
         FreeResource(dHandle);
         end;
         end;
    end;
    
    procedure InsertSmiley(ASmiley: string);
    
    var      ms: TMemoryStream;      s: string;
    
    begin
    
    ms := TMemoryStream.Create;
      try
        s := GetSmileyCode(ASmiley);
        if s <> '' then
          begin
            ms.Seek(0, soFromEnd);
            ms.Write(PChar(s)^, Length(s));
            ms.Position := 0;
            PutRTFSelection(frmMain.RXRichedit1, ms);
          end;
         finally
         ms.Free;
         end;
    end;
    
    procedure TfrmMain.SpeedButton1Click(Sender: TObject);
    begin
      InsertSmiley('Smiley1');
    end;
    
    procedure TfrmMain.SpeedButton2Click(Sender: TObject);
    begin
      InsertSmiley('Smiley2');
    end;
    
     // Replace a :-) or :-( with a corresponding smiley          
    
    procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
    
    var    sCode, SmileyName: string;
    
      procedure RemoveText(RichEdit: TMyRichEdit);
        begin
          with RichEdit do
            begin
              SelStart := SelStart - 2;
              SelLength := 2;
              SelText :=  '';
            end;
        end;
    begin    If (Key = ')') or (Key = '(')  then
      begin
        sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;
        SmileyName := '';
        if sCode = ':-)' then SmileyName := 'Smiley1';
        if sCode = ':-(' then SmileyName := 'Smiley2';
        if SmileyName <> '' then
          begin
             Key := #0;
             RemoveText(RxRichEdit1);
             InsertSmiley('Smiley1');
           end;
       end;
    end;
    
    
    и еще вопросик такой возможно кто знает как можно избежать компилирования файла ресурсов и вставлять их или заменять непосредственно. Премного благодарен буду за все идеи помогите....

    PS: простите за ужасное оформление кода)))
     
  12. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Ставь себе Restorator 2007
     
  13. darckmilord

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

    Joined:
    8 Feb 2007
    Messages:
    50
    Likes Received:
    14
    Reputations:
    0
    === Begin gifs.rc ===
    mygif rcdata "имя_gif-файла.gif"
    mygif1 rcdata "RCDATA_1"
    === End dots.rc ===

    Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res В начало модуля добавь строчку {$R gifs.res}

    Не примите за флуд, но разобрался сам. За рестор спасибо, стоит) о нем не думал даже.
     
  14. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    289
    Reputations:
    43
    [OFFTOP]
    эхх вы хакеры... дык... а взять любой оконный менеджер и сделать:
    1. деактивацию окна
    2. спрятать окно, не тру?
    можно еще DESTROY послать...
    [/OFFTOP]
     
  15. t04

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

    Joined:
    10 Jan 2007
    Messages:
    137
    Likes Received:
    40
    Reputations:
    8
    помогите разобраться, делаю так:
    Code:
    ...
    type
      FLAP_HDR = record
        Sign : byte;
        ChID : byte;
        SEQ  : word;
        Len  : word;
      end;
    ...
    var
      buff:FLAP_HDR;
    begin
      recv(iSock,buff,buff_size,0);
    ...
    
    приходит:
    Code:
    2a 01 df a7 00 04 00 00 00 01
    
    должно приходить(данные снифера):
    Command Start: 0x2a
    Channel ID: New Connection (0x01)
    Sequence Number: 57255
    Data Field Length: 4
    Protocol Version: 00000001

    а у меня приходит
    Sign : 04;
    ChID : 01;
    SEQ : 42975;
    Len : 400;
    то есть в SEQ приходит не
    Code:
    [df a7]
    a
    Code:
    [a7 df]
    а в Len приходит не
    Code:
    [00 04]
    а
    Code:
    [04 00]
    как поменять байты местами что бы все работало нормально?
     
  16. GlOFF

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

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    t04 Ну все хорошо работает и без ошибок! Проблема в недопонимании.
    Уж так повелось, что в процессорах интел-совместимых, числа в памяти идут "Старший байт имеет старший адресс"!!!

    Т.е. когда ты отправишь данные и примишь их "FLAP_HDR" - все встанет на свои места.
     
  17. Inf

    Inf New Member

    Joined:
    28 Oct 2007
    Messages:
    2
    Likes Received:
    0
    Reputations:
    0
    За это конечно благодарствую, но имел в виду немного другое.. нужно изменить иконку так, чтобы при запуске проги эта же иконка отображалась.. сверху... не знаю, как объяснить... там , где название...
     
  18. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    289
    Reputations:
    43
    свойство Icon у формы.
     
    1 person likes this.
  19. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Помогите плз разобраться с ф-цией WaveOutOpen (api)
    Было бы хорошо с примерчиком.
    Курил мсдн, но не помог (
     
  20. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    289
    Reputations:
    43
    гугл


    подробнее тут

    выкинь свой мсдн, переходи на траву посильнее - гугл
     
    #680 W!z@rD, 1 Nov 2007
    Last edited: 2 Nov 2007
Loading...
Thread Status:
Not open for further replies.