Можно ли с помощью компонента NMSMTP отправить изображение? Если да, то как? Если нет, то каким образом можно это реализовать?
Есть ли аналог функции MessageBox(0, 'test', 'text', MB_OK or MB_TOPMOST); Которая будет выводить сообщение поверх всех окон, НО что бы его нельзя было убрать? в данном коде ,после ошибки , елси мы клиенем по другому окну то сообщение о ошибки скрывается за окном. Есть ли какая-нибдуь ошибка которая будет иметь приоритет выше всех окон , что бы эту ошибка не скрывалсь даже елси перейдем на другое окно. хелп плз
MessageBox(0, 'е1', 'e2', MB_OK + MB_ICONQUESTION + MB_TOPMOST); проверено... ничего ни за чем не скрывается. висит поверх всех окон
делаю программу с многопоточностью. При потоках >1, вылетает сообщение: could not bind socket. address and port are already in use собственно вопрос, мб кто подскажет код, чтобы для каждого потока был уникальный порт?
при создании сокета не указывайте явно порт, укажите вместо порта значение 0. В таком случае будет выбран случайный из свободных портов.
делаю многопоточный брут, так как там идут запросы на HTTPS, в коде потока указал: HTTP.IOHandler:=Form1.IdSSLIOHandlerSocketOpenSSL1; а вот что с портом делать не знаю
PHP: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Psock, NMsmtp; type TForm1 = class(TForm) Button1: TButton; localprogram: TEdit; fromname: TEdit; Fromaddress: TEdit; replyto: TEdit; subject: TEdit; Memo: TMemo; Predefined: TLabel; Panel1: TPanel; Panel2: TPanel; SMTP: TNMSMTP; islog: TCheckBox; host: TEdit; port: TEdit; userid: TEdit; FileName: TEdit; procedure Button1Click(Sender: TObject); private procedure CleanContext; procedure PerformConnection; procedure AddMessage(msg: string; color: integer); procedure log(inpt: string); procedure SetSMTP; public function SendEmail(_to, cc, bcc, Subject, body, attachment: string; HTMLFormat: boolean): boolean; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.SetSMTP; begin SMTP.Host := Host.Text; SMTP.Port := strtoint(Port.text); SMTP.UserID := userid.text; end; function GetEmailDateTime: string; var tz: _time_Zone_information; s: string; begin GetTimeZoneInformation(tz); if (tz.Bias * 100 div 60) < 1000 then s := format(' -0%d', [tz.Bias * 100 div 60]) else s := format(' -%d', [tz.Bias * 100 div 60]); result := formatdatetime('ddd, dd mmm yyyy hh:nn:ss', now) + s; end; procedure TForm1.CleanContext; begin SMTP.PostMessage.FromAddress := FromAddress.text; SMTP.PostMessage.FromName := FromName.text; SMTP.PostMessage.ToAddress.Clear; SMTP.PostMessage.ToCarbonCopy.clear; SMTP.PostMessage.ToBlindCarbonCopy.clear; SMTP.PostMessage.Body.clear; SMTP.PostMessage.Attachments.clear; SMTP.PostMessage.Subject := Subject.text; SMTP.PostMessage.LocalProgram := LocalProgram.text; (*Mon, 27 Nov 2000 12:37:46 -0700*) SMTP.PostMessage.Date := GetEmailDateTime; SMTP.PostMessage.ReplyTo := ReplyTo.Text; end; procedure TForm1.log(inpt: string); var outf: textfile; begin if not islog.checked then exit; assignfile(outf, changefileext(paramstr(0), '.log')); if fileexists(changefileext(paramstr(0), '.log')) then append(outf) else rewrite(outf); writeln(outf, datetimetostr(now) + '|' + inpt); closefile(outf); end; procedure TForm1.AddMessage(msg: string; color: integer); begin {showing in the memo field progress...} while memo.lines.Count > 2000 do memo.lines.Delete(0); memo.sellength := 0; memo.selstart := length(memo.text); memo.seltext := #13#10+DateTimeTostr(now) + ' ' + msg; memo.perform($00B7, 0, 0); Application.ProcessMessages; if color <> clRed then log(DateTimeTostr(now) + ' ' + msg) else log('Error: ' + DateTimeTostr(now) + ' ' + msg); end; procedure TForm1.PerformConnection; begin while (not SMTP.connected) do begin SetSMTP; AddMessage('Connecting to SMTP', clBlue); application.processmessages; try SMTP.Connect; AddMessage('No Errors', clBlue); except on e: exception do AddMessage('Error conection: ' + e.message, clBlue); end; end; end; function TForm1.SendEmail(_to, cc, bcc, Subject, body, attachment: string; HTMLFormat: boolean): boolean; begin PerformConnection; result := true; CleanContext; try if (attachment <> '') and (not Fileexists(attachment)) then begin AddMessage('Attachment is not ready yet (' + attachment + ') ', clNavy); sleep(300); result := false; exit; end; SMTP.PostMessage.ToAddress.text := StringReplace(_to, ';', #13#10, [rfReplaceAll, rfIgnoreCase]); if cc <> '' then SMTP.PostMessage.ToCarbonCopy.text := StringReplace(cc, ';', #13#10, [rfReplaceAll, rfIgnoreCase]); if bcc <> '' then SMTP.PostMessage.ToBlindCarbonCopy.text := StringReplace(bcc, ';', #13#10, [rfReplaceAll, rfIgnoreCase]); if Subject <> '' then SMTP.PostMessage.Subject := Subject; if HTMLFormat then SMTP.SubType := mtPlain else SMTP.SubType := mtHtml; SMTP.PostMessage.Body.Text := Body; if attachment <> '' then SMTP.PostMessage.Attachments.add(attachment); AddMessage('Sending to ' + _to, clGreen); SMTP.SendMail; AddMessage('Complete.' + #13#10,clGreen); except on e: sysutils.exception do begin AddMessage(e.message, clRed); result := false; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin SendEmail('[email protected]', '', '', 'test', 'body', FileName.text, False); end; end. end; end. Есть данный код, который впоследствии должен отправлять письмо на почту. Пробовал в Host вбить smtp.yandex.ru под 25 портом, но работать не желает. Может я не тот smtp сервер указал?
Ты в потоке так написал?Попробуй динамически создавать внутри потока это дело(IdSSLIOHandlerSocketOpenSSL1), также как ты HTTP создаешь. Телнетом подключись и посмотри есть коннект или нет.
not allowed before 'ELSE' Вот так пишет procedure TfmExemple.BitBtn1Click(Sender: TObject); var y:integer; begin if edInput.Text = '' then Exit; y:=strtoint(trim(edinput.Text)); edinput.text:=''; edinput.SetFocus; if tag = 0 then if x<y then mmoutput.Lines.Add('x<'+inttostr(y)); else if x>0 then //вот здесь ошибка mmoutput.Lines.Add('x>'+inttostr(y)); else begin mmoutput.Lines.Add('x='+inttostr(y)); massageBeep(MB_ok); lbOutbuk.Caption:='вы угадали! введите 1 если хотите повторить:'; tag:=1; and else if y=1 then begin x:=random(1001); lboutbuk.Caption:='введите число'; tag:=0; edinput.SetFocus; end else close; end;
PHP: type procedure TForm1.SMTPS(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); implementation procedure TForm1.SMTPS(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); begin Memo1.Lines.Insert(0,'Статус отправки: '+AStatusText); end; При компиляции пишет, что после TForm1.SMTPS должен стоять знак '=' вместо скобки. Что не так?
добавь не в типы,а в public или private. procedure SMTPS(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);