ну можеш сделать так Code: procedure TForm1.FormCreate(Sender: TObject); begin showmessage('текст'); end; или так Code: procedure TForm1.FormCreate(Sender: TObject); begin form2.ShowModal;//или form1.Show; чтоб основное окно не блочилось... и еще предворительно надо зайти file->new->form и на эту форму насовать свякого а еще в uses пропиши unit2 чтоб можно было изменить то что на form2 из unit1 end; PS сори что я в 4 раз редактирую... пьяный в хлам //уже в 5
Исходное слово - " word " представляем его в виде 16ного значния, то есть преобразуем каждый симол слова в hex , получаем 776F7264, теперь задача состоит в том , чтобы зная только 776F7264 получить слово " word ". Произвести обратную операцию. Вопрос как ?
Преобразование Ascii в шестнадцатиричное представление Функция BytesToHexStr преобразует, к примеру, набор байтов [0,1,1,0] в строку '30313130', HexStrToBytes выполнит обратное преобразование. Code: unit Hexstr; interface uses String16, SysUtils; type PByte = ^BYTE; procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD); procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer); procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength: WORD); implementation procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD); const HexChars: array[0..15] of Char = '0123456789ABCDEF'; var i, j: WORD; begin SetLength(hHexStr, (InputLength * 2)); FillChar(hHexStr, sizeof(hHexStr), #0); j := 1; for i := 1 to InputLength do begin hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]); inc(j); hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j); inc(pbyteArray); end; end; procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength: WORD); var i: WORD; c: byte; begin SetLength(Response, InputLength); FillChar(Response, SizeOf(Response), #0); for i := 0 to (InputLength - 1) do begin c := BYTE(hexbytes[i]) and BYTE($F); if c > 9 then Inc(c, $37) else Inc(c, $30); Response[i + 1] := char(c); end; {for} end; procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer); {pbyteArray указывает на область памяти, хранящей результаты} var i, j: WORD; tempPtr: PChar; twoDigits: string[2]; begin tempPtr := pbyteArray; j := 1; for i := 1 to (Length(hHexStr) div 2) do begin twoDigits := Copy(hHexStr, j, 2); Inc(j, 2); PByte(tempPtr)^ := StrToInt('$' + twoDigits); Inc(tempPtr); end; {for} end; end. где interface uses String16, SysUtils; Code: unit String16. interface {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); procedure SetString(var Dst: string; Src: PChar; Len: Integer); {$ENDIF} implementation {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); begin if Len > 255 then S[0] := Chr(255) else S[0] := Chr(Len) end; procedure SetString(var Dst: string; Src: PChar; Len: Integer); begin if Len > 255 then Move(Src^, Dst[1], 255) else Move(Src^, Dst[1], Len); SetLength(Dst, Len); end; {$ENDIF} end. взяла с http://delphiworld.narod.ru/ код не проверяла...
Имеем какбы в памяти строку в виде двоичного кода 776F7264. Делаем следующее: 1) дописываем нулевой байт 776F726400 2) wsprint(Buf, "%s", 776F726400); 3) ShowMessage(Buf); Где Buf - это массив из char
Помогите откомпилировать пожалуйста Code: procedure go(); const n=1; m=1; s='key'; var Form1: TForm1; n_ar:array [1..n] of string; m_ar:array [1..m] of string; sites:array [1..n] of string; i:integer; t:string; q,col:integer; steam:TstringStream; begin for i:=1 to n do begin steam:= TStringStream.Create(''); form1.IdHTTP1.get(n_ar[i],steam); t:=steam.DataString; q:=pos(s,t); t:=copy(t,q,length(t)); q:=pos(#39,t); t:=copy(t,1,q); inc(col); sites[col]:=t; end; for i:=1 to col do ShellExecute(Handle,'open',sites[i] , nil, nil, SW_HIDE); for i:=1 to m do ShellExecute(Handle,'open',m_ar[i] , nil, nil, SW_HIDE); end; end; end;
Люди кто может сделайте из этого кода исходник, и залейте его в инет плиз а то у меня чёта неполучается... PHP: {прогу недописал и извратил xXvladXx} unit Unit1; interface uses Windows,SysUtils,Variants,Classes,Forms, OleCtrls,SHDocVw,StdCtrls,Controls; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Button1: TButton; WebBrowser1: TWebBrowser; Edit3: TEdit; procedure Button1Click(Sender: TObject); procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; if WebBrowser.OleObject.Document.all.tags('FORM').Len gth = 0 then begin Exit; end; for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do begin FormItem := WebBrowser.OleObject.Document.forms.Item(I); for j := 0 to FormItem.Length - 1 do begin try if FormItem.Item(j).id = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin webbrowser1.Navigate(edit3.Text); //заходим на сайт который написан в edit3 end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var ovElements: OleVariant; i:integer; begin //это типа такая хрень которая просходит когда тупой WebBrowser загрузит страницу if Url=edit3.Text then begin //тут проверяем где мы щас типа если там где надо то.. FillForm(webbrowser1,'navbar_username',edit1.Text) ; //заполняем navbar_username эт такая хреновина куда логин писать FillForm(webbrowser1,'navbar_password',edit2.Text) ; //заполняем navbar_password эт такая хреновина куда пароль писать ovElements := Webbrowser1.OleObject.Document.forms.item(0).eleme nts; //это чтото страшное for i := 0 to (ovElements.Length - 1) do //тут мы запускаем цикл который проверяет все кнопки на странице if (ovElements.item(i).name='Вход') then //тута проверка типа если на кнопки написано Вход то try //тут исключительный случий(вдруг он кнопку нажать не смог оО ) ovElements.item(i).Click;//тут он пытается её нажать except messageboxa(0,'Что-то не так','Что-то не так',0);//тут тишется чтото в алетр если всетаки не получилось нажать кнопку end; end; end; end. //а тут конец Буду вам очень при очень благодарен.
только IP? как-то ты скромно...) вот как отправить почту ... Code: begin SMTP.Host:='xxx'; // адрес почтового сервера SMTP.Port:=25; // порт по которому будет осуществляться подключение SMTP.Username:='yyy'; // логин пользователя SMTP.Password:='zzz'; // пароль пользователя SMTP.AuthenticationType:=atLogin; // тип подключения к серверу - с авторизацией with IdMessage do begin Recipients.EMailAddresses := 'xxxx'; // майл получателя письма Subject := 'Йа тут'; // тема письма ну или $ip end; SMTP.Connect; try SMTP.Send(IdMessage); finally SMTP.Disconnect; end; end; а чтоб узнать IP достаточно лишь посмотреть код письма (http://www.delphirus.com/article133.html) ... так круче
SetWindowsRgn(Form1.Handle, True); Code: function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN; var X, Y: Integer; XStart: Integer; begin Result := 0; with Bitmap do for Y := 0 to Height - 1 do begin X := 0; while X < Width do begin while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do Inc(X); if X >= Width then Break; XStart := X; while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do Inc(X); if Result = 0 then Result := CreateRectRgn(XStart, Y, X, Y + 1) else CombineRgn(Result, Result, CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR); end; end; end; Где TBitmap - картинка с сердцем , TColor - цвет фона картинки; (Цвета картинки не важны т к вырезается только форма...а цвет делаешь просто картинкой на форме (как текстуру))
Подскажите как сделать чтобы после нажатия на кнопку на Form1, текс с первой формы передовался на Form2. Вроде указываю всё правильно, ошибок не выходит, но Form2 не открывается.
Вопрос не полон у тебя... Не очень понятно, что ты хочешь получить. Как передать текст тебе уже сказали, форму открывай как Code: Form2.Show;
Люди вот есть исходник проги, которая логинатся на сайтах сделанных на движке vBulletin www.forum-mp3.org/browser2.zip кто может сделать так чтобы она находила текст в WebBrowser1- 'Личные сообщения:' и отображала в edit следующие 20 символов которые отображаются после слова 'Личные сообщения:' ??? Плиз очень надо но немогу я это осилеть и всё
я исходник не смотрел , но ничего сложного не вижу совсем... st:= webBrawser1. (тут не то Content , не то Text... (возвращет содержимое браузера как текст)); р := pos('Личные сообщения',st); Edit1.text :=copy(st, p, 20) ;
Jes посмотри исходник, не спрашивал бы если бы все было так просто, там через ОЛЕ скорее всего текст документа взять можно, но как реализовать хз Народ помогите кто может. #754-пост
Code: unit Unit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls; type TForm14 = class(TForm) Button1: TButton; ht1: TIdHTTP; TEdit : Edit1; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form14: TForm14; implementation {$R *.dfm} procedure TForm14.Button1Click(Sender: TObject); var st:string; p:integer; begin st:= ht1.Get('http://Страница/'); р := pos('Личные сообщения',st); // можно pos('Личные сообщения',st) + 16; чтоб убрать надпись "Личные сообщения" Edit1.text :=copy(st, p, 20) ; end; end.
