не совсем дошло) вот исходничок) Code: function mp3(cto: string): string; var F: File; hSession, hURL: HInternet; Buffer: array[1..1024] of Byte; err: boolean; ResumePos,BufferLen,SumSize: DWORD; iii: integer; kyda:string; header, data:string; begin kyda:='1.mp3'; SumSize:=0; ResumePos:=0; AssignFile (F,kyda); IF FileExists (kyda) then begin Reset(f,1); ResumePos:=FileSize(F); Seek(F, FileSize(F)); end else ReWrite(f,1); form1.NADO:= TRUE; hSession:= InternetOpen('MP3 Down',PRE_CONFIG_INTERNET_ACCESS,nil,nil,0); Data:='Content-Type: application/x-www-form-urlencoded'#10; hURL := InternetOpenURL(hSession,PChar(cto),pchar(data),length(data),INTERNET_FLAG_NO_COOKIES,0); WaitForSingleObject(InternetOpenURL.hProcess, INFINITE); InternetQueryDataAvailable(hURL, SumSize,0,0); if ResumePos>0 then begin InternetSetFilePointer(hURL,ResumePos,nil,0,0); end; REPEAT err:= InternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen); IF err= false then begin Result := 'err'; exit; end else begin /// end; BlockWrite(f, Buffer, BufferLen); Application.Processmessages; UNTIL (BufferLen= 0) Or (form1.NADO= FALSE); Result := 'ok'; end;
Есть к примеру такой html код: Code: <html> <head><title>Отпарсите меня пожалуйста :-)</title></head> <body> <a href="http://yandex.ru/">Го на яндекс</a> <a href="http://google.ru/">Го на гугл</a> <a href="http://yahoo.com/">Го на яху</a> </body> </html> Как отпарсить этот код с помощью регулярки? Именно нужно в мемо добавить то что в href стоит Мемо должен такой получится после парсинга Code: http://yandex.ru/ http://google.ru/ http://yahoo.com/ Знаю как парсить один результат а как несколько парсить не знаю :-(
wolmer, ежели использовать RegExpr... Применительно к вашему примеру (s - ваш текст). Code: function extract (const ainputstring : string; buf : string) : tstringlist; var r : tregexpr; f : tstringlist; begin f := tstringlist.create; r := tregexpr.create; try r.expression := buf; if r.exec (ainputstring) then repeat f.add (r.match [0]); until not r.execnext; finally r.free; end; result := f; end; function to_memo (s : widestring) : integer; begin if extract (s, 'http[^"]*[^"]') <> nil then form1.memo1.lines.addstrings (extract (s, 'http[^"]*[^"]')); result := 1; end;
нужно в delphi, на некоторое время выключить (полностью) клаву, я уже мозг себе весь сломал, может кто помочь, это мне нужно для софта: http://fuckav.ru/showthread.php?t=204
Code: procedure BlockInput; external 'user32.dll'; procedure Block; asm push 1 call BlockInput end; procedure UnBlock; asm push 0 call BlockInput end; Найдено в DelphiWorld. Блокировка клавиатуры и мыши, снимается нажатием ctrl+alt+del либо вызовом UnBlock; . Проверил - работает (Vista, XP virt.)
Что-то не могу понять как скачать файл из интернета по средствам Winsock, я знаю что там что-то с recv+while надо делать но что точно не знаю (могу ошибаться) Вообщем помогите по этому вопросу
Как одной кнопке прописать две процедуры? То есть нажимаешь один раз на кнопку выполняется одна процедура, ещё раз нажимаешь - вторая..
Можно переменную какую - нибудь задать типа boolean (например). Можно вызывать процедуру в зависимости от свойства caption кнопки. If button1.caption = 'Go' then begin GO(param1,param2); button1.caption :='Stop'; end else begin STOP(param1,param2); button1.caption :='Go'; end;
Создай переменную-переключатель процедур, и по нажатию кнопки проверяй его значение... Если значение = 1 , то выполняй первую процедуру и переключателю присваивай значение = 2, если = 2 выполняй вторую процедуру, а переключателю присваивай значение 1...
Под завязку Code: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private function Clicks(chto,nachto:integer): boolean; { Private declarations } public { Public declarations } end; var Form1: TForm1; i:integer; implementation {$R *.dfm} function TForm1.Clicks(chto,nachto:integer): boolean; begin if Frac(chto/nachto)<>0 then begin result:=false; end else begin result:=true; end; end; procedure TForm1.Button1Click(Sender: TObject); begin i:=i+1; if Clicks(i,2) then begin showmessage('Это вторая процедура'); end else begin showmessage('Это первая процедура'); end; end; procedure TForm1.FormCreate(Sender: TObject); begin i:=0; end; end. i - счетчик скоко юзер кликнул по кнопке (думаю разберешся сам с гуглом, а если нет то пиши в личку, прокоменчу строки которые надо)
Используй свойство Tag К примеру Procedure form.button1Click(....) begin If button1.tag = 0 then procedure1; if button1.tag = 1 then procedure2; A в этих процедурах меняй тэг на обратный
как скопировать файлы определенного расширения, размера при включении программы все скопированные файлы закидывает в одну папку ?
