Просмотр полной версии : [Delphi]/[Pascal] Задай вопрос, получи ответ
Самый простой способ - перенаправлять вывод в файл через >>
А потом подгружать файл в memo
Остальные способы(через pipe) намного сложнее.
BlackSilver
03.02.2009, 11:42
Ещё вопрос, при выполнении CMD команд через shellexecute или winexec есть ли способ вывести ответ в Memo ???
К примеру команда:
ShellExecute(0,'open','cmd.exe','dir','',0);
и чтобы листинг был в memo
Можно сделать так:
ShellExecute(0,'open','cmd.exe >buf.txt','dir','',0);
И потом считать в Memo уже из файла.
Nightmarе
03.02.2009, 12:20
Можно сделать так:
ShellExecute(0,'open','cmd.exe >buf.txt','dir','',0);
И потом считать в Memo уже из файла.
не пашет ;(
Можно рабочий вариант команды?
BlackSilver
03.02.2009, 12:54
не пашет ;(
Можно рабочий вариант команды?
Ой, >buf -это в параметрах должно стоять.
ShellExecute(0,'open','cmd.exe','dir >buf.txt','',0);
Это как раз и есть перенаправление вывода в файл.
Nightmarе
03.02.2009, 15:20
И всё-таки ещё раз об ошибках.
Вот к примеру код:
Memo1.Text:= IdHTTP1.Get('http://lol.ru');
В никоторых случаях, может у кого инет не пашет или ещё что, может вылезти ошибка, что так и так...
Ну есть хоть какой нить способ обработать каждую команду персонально чтобы 100% ошибок не было???
юзай обработку исключений. Под отладчиком (запуск из под делфи) ошибка будет светиться, но ты просто нажимай продолжить выполнение. А в уже нормально запущенной проге тогда не будет светиться она
try
Memo1.Text:= IdHTTP1.Get('http://lofgdl.ru');
except
// этот код выполнится если будет исключение (ошибка)
showmessage('er'); // можно убрать, тогда ничего не будет происходить
end;
Nightmarе
03.02.2009, 16:28
юзай обработку исключений. Под отладчиком (запуск из под делфи) ошибка будет светиться, но ты просто нажимай продолжить выполнение. А в уже нормально запущенной проге тогда не будет светиться она
try
Memo1.Text:= IdHTTP1.Get('http://lofgdl.ru');
except
// этот код выполнится если будет исключение (ошибка)
showmessage('er'); // можно убрать, тогда ничего не будет происходить
end;
Большое спасибо, помогло при IdHTTP1.
Ну а другие команды точно так же обрабатываются:
try
...
except
???
В частности:
urlmon.URLDownloadToFile
вообще через эту конструкцию обрабатываются любые исключения возвникающие в ходе выполнения какого либо кода.
В частности URLDownloadToFile смотри что возвращает функция. Если вернула 0 - значит удачно скачался файл, любой другой ответ - код ошибки
Столкнулся с проблемой когда выходишь из программы она закрывается не успевая воспроизвести звук как быть ?
имеем такое :
PlaySound('SND4', 0, SND_RESOURCE or SND_ASYNC);
form1.close;
поставь SND_SYNC вместо SND_ASYNC чтобы прожка ждала когда отзвучит до конца звук.
Или как вариант юзая SND_ASYNC - в событии CanClose или Close поставь паузу чтобы звук хоть чуть поиграл
slesh ты великий человек !
Как оказалось у меня в дельфи нет библиотеки indy у меня седьмая версия никак не могу найти в инете эту библиотеку кто может укажите откуда скачивать буду много благодарен
Они есть в 7 версии, но бывают не установленными. Для их установки сделаю следующее в меню:
Component -> Install Packages...-> Add -> в папке delphi\bin выбирай и устанавливай bpl файлы. Там должны быть типа dclindy70.bpl
Как получить список параметров нужного ключа по средствам Api?
http://msdn.microsoft.com/en-us/library/ms724909(VS.85).aspx
примеров не даёт
т.е. тебе нужно поглядеть все значения ветки?
Тебе случаем не эти функции нужны?
RegEnumKey() - перечисление ключей
RegEnumValue() - перечисление значений
slesh
например я знаю имя ключа
HKEY_CURRENT_USER\Software\WinRAR SFX
нужно получить список его параметров
тоесть
D%%Program Files%WinRAR и
D%%WINDOWS%system
Nightmarе
05.02.2009, 16:26
Component - Import ActiveX Control
ShockWave Flash
потом добавляешь в uses ShockwaveFlashObjects_TLB
и создаешь компонент типа TShockWave Flash
и, думаю, надо вытащить во временный файл из ресурса ролик
Как проигрывать флеш я разобрался.
Кидаем все компоненты, и для запуска юзаем:
ShockwaveFlash1.Movie := 'С:\ball.swf';
Label4.Caption := IntToStr(ShockwaveFlash1.TotalFrames);
Но всё-таки как проиграть флешку из .res файла не извлекая его никуда???
ZirroCool
05.02.2009, 19:20
Всем здрасьте!
Подскажите люди добрае как мне отследить запуск какого либо приложения в системе(не важно консольного или оконного), узнать его местонахождение и приостановить на некоторое время!
Буду благодарен за пример, ибо про перехват функций в инете написанно очень много, но слишком много ненужных в моем случае букаф, которые мешают уловить суть!
Когдато я писал подобные вещи. Для 100% работы нужно писать драйвер. Это единственынй нормальный метод.
Суть состоит в том, чтобы система сама уведомляла тебя о запуске процесса.
Для этого делается следующе:
VOID CreateProcessNotifyRoutine(IN HANDLE ParentId, IN HANDLE ProcessId, IN BOOLEAN Create)
{
....-.-.-.-.-.........
}
PsSetCreateProcessNotifyRoutine(*CreateProcessNoti fyRoutine, TRUE);
slesh
например я знаю имя ключа
HKEY_CURRENT_USER\Software\WinRAR SFX
нужно получить список его параметров
тоесть
D%%Program Files%WinRAR и
D%%WINDOWS%system
Ну, видимо
procedure TForm1.Button1Click(Sender: TObject);
var
Key : HKey;
Buf : array[0..1000] of char;
Err, index : longint;
BufSize: Cardinal;
begin
BufSize := 1024;
index:=0;
Err:=RegOpenKey(HKEY_CURRENT_USER,
'Software\WinRAR SFX',Key);
while err=ERROR_SUCCESS do
memo1.lines.add(strpas(Buf));
inc(index);
Err:=RegEnumValue(KEY, index, buf,BufSize, nil, nil, nil, nil);
end;
ZirroCool
05.02.2009, 23:34
FindeR, речь идет не о конкретных приложениях, а обо всех!
slesh, спасибо погуглю в эту сторону!
FindeR, речь идет не о конкретных приложениях, а обо всех!
эм...я ZET36 отвечал
ZirroCool
06.02.2009, 02:04
FindeR, сорь видимо не очень внимательно прочитал!)
FindeR Огромное спасибо, смысл понятен, немножко подправил код
procedure TForm1.Button1Click(Sender: TObject);
var
Key : HKey;
Buf : array[0..1000] of char;
Err, index : longint;
BufSize: Cardinal;
zz: string;
begin
BufSize := 1024;
index:=0;
Err:=RegOpenKey(HKEY_CURRENT_USER,
'Software\WinRAR SFX',Key);
while err=ERROR_SUCCESS do
begin
if strpas(Buf)<>'' then memo1.lines.add(strpas(Buf));
Err:=RegEnumValue(KEY, index, buf,BufSize, nil, nil, nil, nil);
inc(index);
end;
end;
подскажите пожалуйста как мне отправить текст из memo1 с помощью UdpSocket1
UdpSocket1.SendTo:=(memo1.text)
P.S так вот невыходит что то почемуто
De-visible
06.02.2009, 17:27
write, writeln...
socket.send...
а можно немного попонятнее а то я только целиком коды понимаю
Здравствуйте
Такой вопрос
Не могу понять суть процедуры
Можете привести простой пример?
Вызова процедуры :)
Вроде все до функций и процедур было понятно,а тут вообще запутался)
turbo pascal
program Perestanovka;
var N,I:byte;
procedure Swap(var a,b:byte);
var c:byte;
begin
c:=a;
a:=b;
b:=c
end;
begin
write('N=');
readln(N);
write('I=');
readln(I);
Swap (N,I);
writeln('N=',N);
writeln('I=',I);
end.
Вот смотри. Создали процедуру swap, которая меняет содержимое двух целочисленных ячеек местами. В месте мы можем вызвать её указав в скобках необходимые параметры - в данном случае переменные, которые должны быть обменяны. Если вызвать Swap (N,I); ещё раз, то значения станут первоначальными. Если не понятно ещё что-то, то проще уже учебник взять, легко и самому понять.
Если не понятно ещё что-то, то проще уже учебник взять, легко и самому понять.
вот именно я учебник взял!Сейчас все понял!Спасибо=)
ICQClient1 - помогите с етим компонентом, меня интересует как обрабативать входяшие сообшения, ну и все все про етот клиент) ну важнее обработка вхожяших сообшений)
Если можна дайте пример)
Вот архив (http://coderszone.info/engine/download.php?id=31) со статьёй, рассматривается работа с TICQClient, хватит на первое время, так же вот форум (http://forum.volkov.spb.su/index.php?board=2.0), где обсуждают этот компонент, всё самое свежее там
У меня такой вопрос, можно ли как то сделать так что бы программа запущенная в досе , написанная на паскале, не была видна в панеле задач?
vikseriq
08.02.2009, 17:48
Если всмысле консольная, то забей. Все равно учитель информатики твой умнее тебя, а трояны на TP есть мастдай )
Можно юзать WinApi HideTaskbar и setOpacity, но это прокатит только во FreePascal
Мысли сумасшедщего на эту тему:
Мысль первая: всю прожку замутить как резидент, чтобы даже после запуска из консоли небыло заметно что прожка висит.
Реализация первой мысли:
Ассемблерная вставка которая ставит обработчкий на таймер, а затем делает себя резидентной.
В обработчике таймера снять обработку и уже продолжить свою работу )
Резидентимся так:
mov ah,25h
mov al,1Ch
lea dx,MYFUNCTION
int 21h
lea dx,init ;
int 27h
Мысль вторая: В себе таскать маленькую прожку которая скроет тебя из таск бара.
При старте проги твоей она из себя сохраняет на винт вторую прожку и запускает её.
Далее вторая прожка прячет освновную )
Изврат, но всёже невозможностей не существует )
Мысли сумасшедщего на эту тему:
Мысль первая: всю прожку замутить как резидент, чтобы даже после запуска из консоли небыло заметно что прожка висит.
Реализация первой мысли:
Ассемблерная вставка которая ставит обработчкий на таймер, а затем делает себя резидентной.
В обработчике таймера снять обработку и уже продолжить свою работу )
Резидентимся так:
mov ah,25h
mov al,1Ch
lea dx,MYFUNCTION
int 21h
lea dx,init ;
int 27h
Интересно , я так и думал что что то с помощью ассемблера надо, а куда это вставлять?Вот есть прога
uses crt;
var a:text;
i1,i2,i3,n:integer;
begin
for i1:=97 to 122 do
begin
for i2:=97 to 122 do
begin
for i3:=97 to 122 do
begin
assign(a,'c:\file'+chr(i1)+chr(i2)+chr(i3)+'.txt)
rewrite(a);
for n:=1 to 30000 do
begin
write(a,'----------------');
end;
close(a);
end;
end;
end;
end.
Строго не судите, просто делать было нечего, а в школе места на дисках по 5-10 гиг , так что забьёт быстро. И такой вопрос , можно их сдалеть скрытыми файлы? И пожалуйста разесни куда вставлять код ассемблера :) 2 вариант интересный, но боюсь моих знаний для его реализации не хватит :mad:
Создать базу данных о сдаче студентами сессии. Основная таблица «деканат» должна содержать поля : код_фамидии, дисциплина, оценка, дата_сдачи.
Заполнить таблицу деканат достаточно для 5 студентов, а таблицу ведомости для 15 записей.
Создать форму, на которой предусмотреть интерфейс, позвол. Осуществлять след запросы:
1. список студентов, сдавших данную дисциплину;
2. Список групп, сдавших данную дисциплину данного числа;
3. список отличников
4. список отличников по данной дициплине.
помогите сделать, пожалуйста....
http://narod.ru/disk/5561250000/db1.rar.html - файлег с базой
De-visible
09.02.2009, 02:30
Интересно , я так и думал что что то с помощью ассемблера надо, а куда это вставлять?Вот есть прога
uses crt;
var a:text;
i1,i2,i3,n:integer;
begin
for i1:=97 to 122 do
begin
for i2:=97 to 122 do
begin
for i3:=97 to 122 do
begin
assign(a,'c:\file'+chr(i1)+chr(i2)+chr(i3)+'.txt)
rewrite(a);
for n:=1 to 30000 do
begin
write(a,'----------------');
end;
close(a);
end;
end;
end;
end.
Строго не судите, просто делать было нечего, а в школе места на дисках по 5-10 гиг , так что забьёт быстро. И такой вопрос , можно их сдалеть скрытыми файлы? И пожалуйста разесни куда вставлять код ассемблера :) 2 вариант интересный, но боюсь моих знаний для его реализации не хватит :mad:
а в школе места на дисках по 5-10 гиг , так что забьёт быстро.
Не думаю... юзай потоки.
1. список студентов, сдавших данную дисциплину;
2. Список групп, сдавших данную дисциплину данного числа;
3. список отличников
4. список отличников по данной дициплине.
Тебе именно перекрёстный запрос нужен, или уже полученные данные можно обработать?
Не думаю... юзай потоки.
однажды мне один человек, не особенно знакомый со всякими апишками и тп, расскзывал, что им на какой-то олимпиаде удавалось за 2 секунды выполнения программы записывать около гигабайта. вроде обычными write();
Я бы забивал как-нибудь типа юзая WriteFile с адресом буфера равным imagebase и указанием большого размера
вот пытаюсь другому приложению поставить в TEdit текст: Тест
чего то непашет... да, и ещё в самом приложении 2 Tedita... как мне показать что именно в нужный поставить? приложение называеться 1.exe и заголовок тоже 1.exe
var
h,h1: hwnd;
begin
h:=Findwindow(0,'1.exe');
h1:=FindWindowEx(h,0,'TEdit',nil);
SetWindowText(h,'Тест');
end;
svalck
var h,h0:hwnd;
begin
h:=FindWindow(nil, '1.exe');
h0:=FindWindowEx(h,0,'EDIT',nil);
SendMessage(h0, WM_SETTEXT, 0, Integer(PChar('тест'))) ;
end;
SetWindowText устанавливает текст заголовка как раз-таки. В твоём примере, по идее, заголовок должен стать test вместо 1.exe.
И, кстати, для чего ты ищешь h1, если всё равно её потом не используешь? ;)
svalck
var h,h0:hwnd;
begin
h:=FindWindow(nil, '1.exe');
h0:=FindWindowEx(h,0,'EDIT',nil);
SendMessage(h0, WM_SETTEXT, 0, Integer(PChar('тест'))) ;
end;
SetWindowText устанавливает текст заголовка как раз-таки. В твоём примере, по идее, заголовок должен стать test вместо 1.exe.
И, кстати, для чего ты ищешь h1, если всё равно её потом не используешь? ;)
косяк... SetWindowText(h,'Тест');
там должно было быть SetWindowText(h1,'Тест');
Всё работает! спасиба! такой вопрос почему если в приложении 2 Tedita то в моём случае он тест запишет в Tedit2? а не в Tedit1 ?
BlackSilver
09.02.2009, 16:37
Подскажите аналог функции getcwd в delphi. Она узнает адрес активной директории
Ну так что никто не знает как прогу скрыть?
То, что я привел код - это ты врядли сможешь написать програмку которая будет это юзать. А скрывать досовские проги - это просто бесполезное дело.
понятно, ну тогда подскажите как сделать чтобы прога не убивалась в процессах , прога написанная на Делфи. Ну то есть её не было в процессах, и как добавить прогу в автозагрузку, ну чтоб после 1 запуска она добовлялась сама, заранее спасибо))
Djezul, вирусописание (если то, что ты собрался делать, можно так назвать) тут не приветствуется. К тому же, юзай поиск. Тема заезженная донельзя уже. Инфы просто море.
http://argon.com.ru/windows/winxp/xpautorun
http://www.codenet.ru/progr/delphi/stat/registry.php
http://bugtraq.ru/library/programming/invisible.html
http://forum.sources.ru/index.php?showtopic=201846&st=0&#entry1687194
Djezul, вирусописание (если то, что ты собрался делать, можно так назвать) тут не приветствуется.
Спасибо, да не я вообще не собираюсь заниматься виросописанием , да и делфи я не знаю , это просто другу надо , он увлекается, а инета у него нет только сеть, вот я ему и помогаю :) Мне больше подуше Web программирование
На счет чтобы в процессах не винда была - юзать 5005 статей по делфи. там есть некотоыре вишки связанные с этим.
Добавление в авторан - поищи на форуме тут. Был код и на асме и на дельфе.
Nightmarе
10.02.2009, 12:02
Команда на получение листинга дитектории:
procedure TForm1.Button1Click(Sender: TObject);
var
Searchrec: Tsearchrec;
s:string;
begin
FindFirst('C:\*.*', FaAnyfile, SearchRec);
if (SearchRec.Attr and faDirectory)<>0 then s:='C:\' else s:='C:\';
memo2.Lines.Add(s+SearchRec.Name);
while FindNext(SearchRec) = 0 do
begin
if (SearchRec.Attr and faDirectory)<>0 then s:='C:\' else s:='C:\';
memo2.Lines.Add(s+SearchRec.Name);
end;
end;
Подскажите плиз, как сделать так, чтобы скрытые файлы и папки были помечены тегами
то есть:
file1.exe
hidefile.exe
file2.exe
Djezul Вот пример реализации через Хуки и dll http://hacker.3dn.ru/publ/7-1-0-31
Сам использую
Команда на получение листинга дитектории:
procedure TForm1.Button1Click(Sender: TObject);
var
Searchrec: Tsearchrec;
s:string;
begin
FindFirst('C:\*.*', FaAnyfile, SearchRec);
if (SearchRec.Attr and faDirectory)<>0 then s:='C:\' else s:='C:\';
memo2.Lines.Add(s+SearchRec.Name);
while FindNext(SearchRec) = 0 do
begin
if (SearchRec.Attr and faDirectory)<>0 then s:='C:\' else s:='C:\';
memo2.Lines.Add(s+SearchRec.Name);
end;
end;
Подскажите плиз, как сделать так, чтобы скрытые файлы и папки были помечены тегами
то есть:
file1.exe
hidefile.exe
file2.exe
if (SearchRec.Attr = faHidden) then
Memo1.Lines.Add('' + SearchRec.Name + '');
Помогите решить пожалуйста. Задача олимпиадная, но рабочего решения найти не могу(
Найти числа, меньшие N, которые представляется суммой четырех квадратов натуральных чисел не единственным образом.
Привет всем.
Скажите пожалуйста...
как определить Handle активного окна.
Нужно чтобы по таймеру велся лог программы с которой сейчас работает пользователь.
Привет всем.
Скажите пожалуйста...
как определить Handle активного окна.
Нужно чтобы по таймеру велся лог программы с которой сейчас работает пользователь.
Получить Handle и имя класса окна под мышкой
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure ShowHwndAndClassName(CrPos: TPoint);
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Timer1Timer(Sender: TObject);
var
rPos: TPoint;
begin
if Boolean(GetCursorPos(rPos)) then ShowHwndAndClassName(rPos);
end;
procedure TForm1.ShowHwndAndClassName(CrPos: TPoint);
var
hWnd: THandle;
aName: array [0..255] of Char;
begin
hWnd := WindowFromPoint(CrPos);
Label1.Caption := 'Handle : ' + IntToStr(hWnd);
if Boolean(GetClassName(hWnd, aName, 256)) then
Label2.Caption := 'ClassName : ' + string(aName)
else
Label2.Caption := 'ClassName : not found';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.FormStyle := fsStayOnTop;
Timer1.Interval := 50;
end;
а можно чтобы вместо вместо handle текущего класса...возвращала handle программы которой он принадлежит
все...разобрался уже.....большое спасибо
Какие существуют методы для позиционирования на N-й записи таблицы.
Вопрос не совсем понятен. Какое позиционирование?
ну тоесть перехода к N-ой записи..
В TStringGrid что ли? Если да, то вот способ
type
TGridCracker = class(TStringGrid);
{...}
implementation
{...}
procedure SetCaretPosition(Grid: TStringGrid; col, row, x_pos: Integer);
begin
Grid.Col := Col;
Grid.Row := Row;
with TGridCracker(Grid) do
InplaceEditor.SelStart := x_pos;
end;
// Получаем позицию каретки
function GetCaretPosition(Grid: TStringGrid): Integer;
begin
with TGridCracker(Grid) do
Result := InplaceEditor.SelStart;
end;
// Например
// Фокусируем на колонку 1, ряд 3 и позиция каретки 5
procedure TForm1.Button1Click(Sender: TObject);
begin
StringGrid1.SetFocus;
SetCaretPosition(StringGrid1, 1, 3, 5);
end;
Здравствуйте
Проблема при сохранении файла
Процедура:
procedure TForm1.Save1Click(Sender: TObject);
begin
if saveDialog1.Execute then Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
Фильтр:
bat|*.bat|sys|*.sys|htm|*.htm|php|*.php|sql|*.sql
Но почему то при сохранении расширение не прописывается
Помогите найти ошибку:)
Попробуй так, если сработает, то просто подставляй что надо.
procedure TForm1.Save1Click(Sender: TObject);
begin
if saveDialog1.Execute then Memo1.Lines.SaveToFile(SaveDialog1.FileName+'.sql' );
end;
мне нужны разные варианы.Такой же фильтр при открытии файла,работает,а этот нет:)
посоветуйте хорошую книгу по паскалю?
Тебе для чего? Писать проги - врядли паскаль хорош для этого, а если изучение алгоритмов, то другой вопрос.
Здравствуйте, очень нужно решить эту задачку... очень прошу, кто сможет... нужно составить прогу не важно на каком...
Например:
Нужно найти всевозможные комбинации от 1 до 40 состоящиe из 8 чисел... например приведу несколько вариантов комбинаций: 1.2.3.4.5.6.7.8 ; 1.2.3.4.5.6.7.9 ; 1.2.3.4.5.6.7.39 ; 1.2.3.4.5.6.24.40 ; 2.7.9.16.23.25.33.37.
Ну и чтоб можно было вводить(изменять) эти значения(т.е. значения 40 и 8).
Буду очень благодарен...
Отблагодарю репутацией.
Спасибо за внимание.
program Sequences;
type Sequence=array [byte] of byte;
var M,N,i:byte;
X:Sequence;
Yes:boolean;
procedure Next(var X:Sequence;var Yes:boolean);
var i:byte;
begin
i:=N;
{поиск i}
while (i>0)and(X[i]=M) do begin X[i]:=1;dec(i) end;
if i>0 then begin inc(X[i]);Yes:=true end
else Yes:=false
end;
begin
write('M,N=');readln(M,N);
for i:=1 to N do X[i]:=1;
repeat
for i:=1 to N do write(X[i]);writeln;
Next(X,Yes)
until not Yes
end.
N - кол-во элементов (8 в твоём случае)
M - верхняя граница (40 в твоём случае)
А вообще учи комбинаторику, чисто комбинаторная задача.
Syntaxys
16.02.2009, 02:20
Подскажиет пожалуйста, как можно вывести значения нескольких переменных типа string в memo, причем значения пеерменных должны отображаться столбиком.
Например a:=1 b:=3 c:=5
В поле мемо выглядит как
1
3
5
Hellsp@wn
16.02.2009, 02:41
var
ss,s1,s2,s3 : string;
begin
s1 := '1';
s2 := '2';
s3 := '3';
ss := s1 + #13#10 + s2 + #13#10 + s3;
memo1.Lines.Add(ss);
.... или
memo1.Lines.Add(s1);
memo1.Lines.Add(s2);
memo1.Lines.Add(s3);
Syntaxys
16.02.2009, 18:51
Спасибо.
Stil Free
17.02.2009, 17:00
всем доброго времени суток у меня такой тяжёленький вопрос надеюсь поможете обрыл всё что мог на делфикинге не помогают. В общем написал прогу по отправке письма , но я хочу её модифицировать и сделать отправку с подменой адреса как это осуществить?
Стукните ко мне в аську той кто розбираеться в делфи !
всем доброго времени суток у меня такой тяжёленький вопрос надеюсь поможете обрыл всё что мог на делфикинге не помогают. В общем написал прогу по отправке письма , но я хочу её модифицировать и сделать отправку с подменой адреса как это осуществить?
Нужен хостинг с php и sendmail . На сколько я знаю, бесплатно таких трудно найти, а если найти то работают они на 50%. Поэтому юзается платный хостинг. То есть закидываешь скрипт на этот хост и через него посылаешь сообщения анонимно. Все попытки отредактировать MIME ну и так далее к нужному результату не приведут :)
Nightmarе
19.02.2009, 01:47
Помогите решить проблемму кому не в лом, есть процедура отправки файлов с компа на сервер.
// Отправляем файл гейту
procedure TForm1.postdownload;
var
d:TIdMultiPartFormDataStream;
begin
d:=TIdMultiPartFormDataStream.Create;
d.AddFile('userfile',Edit1.text,'file');
try
IdHTTP1.Post('http://gate.ru/lol.php'+'?',d);
except
IdHTTP1.Disconnect;
end;
end;
Вот собственно полный код отправки файла на сервер, проблемма кроется в том, что после 2-3 переданных файлов на сервер, вся программа как бы виснет и не функционирует, всё окончательно сводится на этот кусок кода, есть ли возможность исправить ошибку чтобы программа не висла ?
De-visible
19.02.2009, 01:52
Помогите решить проблемму кому не в лом, есть процедура отправки файлов с компа на сервер.
// Отправляем файл гейту
procedure TForm1.postdownload;
var
d:TIdMultiPartFormDataStream;
begin
d:=TIdMultiPartFormDataStream.Create;
d.AddFile('userfile',Edit1.text,'file');
try
IdHTTP1.Post('http://gate.ru/lol.php'+'?',d);
except
IdHTTP1.Disconnect;
end;
end;
Вот собственно полный код отправки файла на сервер, проблемма кроется в том, что после 2-3 переданных файлов на сервер, вся программа как бы виснет и не функционирует, всё окончательно сводится на этот кусок кода, есть ли возможность исправить ошибку чтобы программа не висла ?
http:TidHTTP;
Begin
http:=TidHTTP.create(nil);
....
....
http.Free;
End;
Хм...Так?
Nightmarе
19.02.2009, 02:34
De-visible ещё раз спасибо, твой вариант подошёл лучше остальных.
Нужно написть что-то наподобии графического редактора. Посоветуйте у кого был опыт какой компонент лучше всего использовать для этого? Пока из мыслей только Image, на нём рисовать, но думаю дальше паинта не уйду. Желатьельно чтобы можно было делать слои и поддерживалась прозрачность.
Maxxxtri23
19.02.2009, 19:40
Я новичек в делфи, поэтому просьба не пинать. Как сделать так чтоб этот кусок кода выполнялся 10 раз и останавливался?
ICQclient1.SendMessage(StrToInt(target.Text),edit. text);
Sleep(200);
ICQclient2.SendMessage(StrToInt(target.Text),edit. text);
Sleep(200);
ICQclient3.SendMessage(StrToInt(target.Text),edit. text);
И вот еще при ипользовании оператора Sleep программа немного подвисает, как сделать чтоб клиенты по очереди слали сообщения с определенным промежутком времени. Тоесть мне надо например при нажатии на кнопку 3 этих ICQClient'а будут слать сообщения с имтервалом 200мс 10 раз, тоесть с итоге должно получится 30 сообщний
Эм, циклом?
For x:=1 to 10 do begin
ICQclient1.SendMessage(StrToInt(target.Text),edit. text);
Sleep(200);
ICQclient2.SendMessage(StrToInt(target.Text),edit. text);
Sleep(200);
ICQclient3.SendMessage(StrToInt(target.Text),edit. text);
end;
А от зависаний я пользовался Аpplication.ProcessMessages(), но при сложных расчётах, как со слипом будет работать - не скажу. Ну либо компонентом TIdAntiFreeze
crystalbit
19.02.2009, 20:24
чтоб не зависало тут или в отдельном потоке или
procedure sleep(ms:cardinal);
var
tc:cardinal;
begin
tc:=GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-tc > ms;
end;
Всем привет!
Есть задача подсчитать кол-во предложений в тексте.
1. Есть ли что-то готовое на этот счёт?
2. Начала реализовывать вот так:
clrscr;
assign(text, 'text.txt');
reset(text);
while not EOF(text) do
begin
read(text, simb);
write(simb);
if (simb='.')or(simb='!')or(simb='?') then inc(kol);
end;
writeln;
writeln ('Текст состоит из ',kol,' предложений');
readln;
close(text);
Но получается что для более точного подсчёта предложений мне нужно знать что находится перед символами "." "!" "?", а использовать стандартные функции работы с текстом нельзя и массивы тоже.
Подскажите пожалуйста как выйти из данной ситуации?
Примерно так делай. Определит все предлложения кроме незаконченных символами . ? !
var
s,tmp:string;
x,len,cnt:integer;
f:text;
begin
cnt:=0;
assign(f,'input.txt');
reset(f);
while not eof(f) do
begin
readln(f,s);
len:=length(s);
for x:=1 to len-1 do // перебираем все символы кроме последнего
begin
// 1 - Eсли удовлетваряет услови.
// 2 - чтобы исключить ... .? !? итд
if (s[x] in ['!','?','.']) and (s[x+1] in ['!','?','.']=false) then inc(cnt);
end;
if (s[len] in ['!','?','.']) then inc(cnt);
end;
вывод cnt
Примерно так делай. Определит все предлложения кроме незаконченных символами . ? !
var
s,tmp:string;
x,len,cnt:integer;
f:text;
begin
cnt:=0;
assign(f,'input.txt');
reset(f);
while not eof(f) do
begin
readln(f,s);
len:=length(s);
for x:=1 to len-1 do // перебираем все символы кроме последнего
begin
// 1 - Eсли удовлетваряет услови.
// 2 - чтобы исключить ... .? !? итд
if (s[x] in ['!','?','.']) and (s[x+1] in ['!','?','.']=false) then inc(cnt);
end;
if (s[len] in ['!','?','.']) then inc(cnt);
end;
вывод cnt
Спасибо тебе конечно, но переменными типа string пользоваться нельзя, так же как и массивами :(
тогда идем так:
var
c,last_c:char;
cnt:integer;
f:text;
begin
cnt:=0;
last_c:=' ';
assign(f,'input.txt');
reset(f);
while not eof(f) do
begin
read(f,c);
if (c in ['!','?','.']) and (last_c in ['!','?','.']=false) then inc(cnt);
last_c:=c;
end;
close(f);
вывод cnt
Странно, всё нормально но выдаёт 0.
Ни разу не видел такой синтаксис:
(last_c in ['!','?','.']=false)
Но суть понятна: если прошлвый символ <> ни одному элементу этого массива то...
//Всё окей, прошу прощения, мои глюкю
((last_c in ['!','?','.'])=false) ;)
slesh Спасибо что не оставил без внимания! :rolleyes:
Nightmarе
20.02.2009, 23:22
Есть ли способ проверить текст в memo на наличии DOS кодировки, есть ли она там или нет ?
De-visible
20.02.2009, 23:43
тогда идем так:
var
c,last_c:char;
cnt:integer;
f:text;
begin
cnt:=0;
last_c:=' ';
assign(f,'input.txt');
reset(f);
while not eof(f) do
begin
read(f,c);
if (c in ['!','?','.']) and (last_c in ['!','?','.']=false) then inc(cnt);
last_c:=c;
end;
close(f);
вывод cnt
Slesh Есть недочеты в коде:
Вот пофикси.
f:TextFile;
assignfile(f,'input.txt');
closefile(f);
De-visible
20.02.2009, 23:44
Спасибо тебе конечно, но переменными типа string пользоваться нельзя, так же как и массивами :(
а типа чар?
De-visible
20.02.2009, 23:51
Есть ли способ проверить текст в memo на наличии DOS кодировки, есть ли она там или нет ?
По сабжу:
http://tinyurl.com/bshrcd
http://tinyurl.com/asyna4
Nightmarе
21.02.2009, 00:08
По сабжу:
http://tinyurl.com/bshrcd
http://tinyurl.com/asyna4
Спс, про конверт я и так в курсе, но мне нужна именно проверка, а не конверт.
Slesh Есть недочеты в коде:
Вот пофикси.
f:TextFile;
assignfile(f,'input.txt');
closefile(f);
Text просто должен везде работать.
assignfile - это в делфе. если в паскале, то assign.
А вообще мегачит, работает везде - reset(f, 'file.txt');
а лучше сразу reset(input, 'file.txt');
PS мультипостить нехорошо )
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute (Form1.Handle, nil, 'http://google.ru', nil, nil, SW_RESTORE);
end;
end.
Как сделать чтоб один раз кликнул а он открылся много раз ? Подскажите плиз и еще как таймером пользоватся чтоб прога сама закрывалась через определенное время.
з.ы Не судите строго только начинаю изучать)) кста посоветуйте нормальный сайт с уроками и с примерами програм и кодов)))
Как сделать чтоб один раз кликнул а он открылся много раз ?
Создаешь цикл для данной операции:
procedure TForm1.Button1Click(Sender: TObject);
var
i:word;
begin
for i:=1 to 10 do // Сколько раз надо (в данном случае 10)
ShellExecute (Form1.Handle, nil, 'http://google.ru', nil, nil, SW_RESTORE);
end;
Подскажите плиз и еще как таймером пользоватся чтоб прога сама закрывалась через определенное время.
Есть несколько способов реализовать это. Ну например так:
Кидаешь на форму Timer (закладка System). Двойной клик по нему и пишешь
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Tag:=Timer1.Tag+1;
if Timer1.Tag>10 then
Form1.Close;
end
В данном случае через 10 сек форма закроется.
кста посоветуйте нормальный сайт с уроками и с примерами програм и кодов)))
www.sources.ru
http://delphiworld.narod.ru/
Спасибо. А вот есть еще progressbar можно сним пример чтоб полоса загрузки двигалась или еще че)
Скажите код чтоб кликнуть по button1 и в директорие(как менять директорию что в Windows файл записавался) где прога создался тхт файл с сообщением внутри? еще как делать перенос на другую строчку ?(допустим: Writeln('Тртртртр "и вот здесь мне надо на новую строчку" ')
Посоветуйте учебник по паскалю
Здравствуйте,помогите найти ошибку! :)
var
day:string;
a:real;
begin
case a of
1,2,3,4,5: day:='Будни' ;
6: day:='Суббота!';
7: day:='Вск!';
end.
kevmen,
var
day:string;
a:integer;
begin
case a of
1,2,3,4,5: day:='Будни' ;
6: day:='Суббота!';
7: day:='Вск!';
end;
end.
Есть код:
procedure TForm1.Button5Click(Sender: TObject);
var SL: TStringList;
begin
b:= FindWindow (nil,'Form1');
If b <> 0 then
SendMessage(FindWindow(nil,'Form1'),WM_Close,0,0);
Sl:=TStringList.Create;
if FileExists('bad.txt') then SL.LoadFromFile('bad.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('bad.txt');
SL.Free;
memo2.lines.loadfromfile('bad.txt')
else
Sl:=TStringList.Create;
if FileExists('good.txt') then SL.LoadFromFile('good.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('good.txt');
SL.Free;
end;
Пишед ошибку 'END' expected but 'ELSE' found
В инете накопал это:
0.<Что-то1> expected but <Что-то2> found. Обычно это сообщение возникает при синтаксической ошибке.Например,в случае небаланса скобок,компилятор сообщит: ')' expected but ';' found (вместо ожидавшейся скобки найдена запятая). Компилятор часто сообщает, что 'end' ожидается,например:x:= 5,7; здесь неуместен разделитель-запятая, а сообщается про end. ('END' expected but ',' found)
Но повозившись ниче путного так и не получилось(( Постоянно сталкиваюсь с этой ошибкой. 3 раз уже менял алгоритм программы((((
Maxxxtri23
22.02.2009, 13:01
Попробуй так:
procedure TForm1.Button5Click(Sender: TObject);
var SL: TStringList;
begin
b:= FindWindow (nil,'Form1');
If b <> 0 then
begin
SendMessage(FindWindow(nil,'Form1'),WM_Close,0,0);
Sl:=TStringList.Create;
if FileExists('bad.txt') then SL.LoadFromFile('bad.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('bad.txt');
SL.Free;
memo2.lines.loadfromfile('bad.txt')
end;
else
begin
Sl:=TStringList.Create;
if FileExists('good.txt') then SL.LoadFromFile('good.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('good.txt');
SL.Free;
end;
end;
Maxxxtri23
22.02.2009, 13:09
Есть у меня такой код:
bot1.Disconnect;
bot2.Disconnect;
bot3.Disconnect;
bot4.Disconnect;
bot5.Disconnect;
bot6.Disconnect;
bot7.Disconnect;
bot8.Disconnect;
bot9.Disconnect;
bot10.Disconnect;
Как мне сделать так чтоб использовался цикл, вот что-то вроде такого
For i:=1 to 10 do begin
bot[i].Disconnect;
end;
ааааааа
procedure TForm1.Button5Click(Sender: TObject);
var SL: TStringList;
begin
b:= FindWindow (nil,'Form1');
If b <> 0 then
begin
SendMessage(FindWindow(nil,'Form1'),WM_Close,0,0);
Sl:=TStringList.Create;
if FileExists('bad.txt') then SL.LoadFromFile('bad.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('bad.txt');
SL.Free;
memo2.lines.loadfromfile('bad.txt')
end
else
begin
Sl:=TStringList.Create;
if FileExists('good.txt') then SL.LoadFromFile('good.txt');
SL.Add(PChar('' + memo1.Lines[0] + ''));
SL.SaveToFile('good.txt');
SL.Free;
end;
end;
Так работает СПС!
Ещё вот такой вопрос
Есть кусок кода ну например
procedure TForm1.Button3Click(Sender: TObject);
begin
WinExec(PChar('ping.exe ' + memo1.Lines[0] + ''), sw_show);
+++++++
showmessage ('ааааааа!!!')
end;
Нужно где я поставил +++++ сделать 30 секундное ожидание Тоесть нажал на кнопку пропинговался хост Через 30 сек появилось сообщение.....
UPD: Через таймер не предлагать!!!!
search74
22.02.2009, 14:07
Скажите код чтоб кликнуть по button1 и в директорие(как менять директорию что в Windows файл записавался) где прога создался тхт файл с сообщением внутри?
procedure TForm1.Button1Click(Sender: TObject);
var
f: TextFile;
fName: String[80];
begin
fName := '1.txt;
AssignFile(f, fName);
Rewrite(f);
writeln(f, 'Твое сообщение');
CloseFile(f);
MessageDlg('сообщение записанов в файл 1.txt',mtInformation,[mbOk],0);
end;
search74
22.02.2009, 14:10
еще как делать перенос на другую строчку ?(допустим: Writeln('Тртртртр "и вот здесь мне надо на новую строчку" ')
Writeln('Тртртртр ');
Writeln('и вот здесь мне надо на новую строчку');
Ещё вот такой вопрос
Есть кусок кода ну например
procedure TForm1.Button3Click(Sender: TObject);
begin
WinExec(PChar('ping.exe ' + memo1.Lines[0] + ''), sw_show);
+++++++
showmessage ('ааааааа!!!')
end;
Нужно где я поставил +++++ сделать 30 секундное ожидание Тоесть нажал на кнопку пропинговался хост Через 30 сек появилось сообщение.....
UPD: Через таймер не предлагать!!!!
procedure TForm1.Button3Click(Sender: TObject);
begin
WinExec(PChar('ping.exe ' + memo1.Lines[0] + ''), sw_show);
Sleep(сколько_ждать);
showmessage ('ааааааа!!!')
end;
А нельзя ли сделать так чтоб на время выполнения команды прога не зависала?
Maxxxtri23
22.02.2009, 14:41
Вот эту процедурку пропиши:
procedure sleep(ms:cardinal);
var
tc:cardinal;
begin
tc:=GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-tc > ms;
end;
Maxxxtri23
22.02.2009, 14:46
Собсно АП, или никто не знает как это сделать? =(
Есть у меня такой код:
bot1.Disconnect;
bot2.Disconnect;
bot3.Disconnect;
bot4.Disconnect;
bot5.Disconnect;
bot6.Disconnect;
bot7.Disconnect;
bot8.Disconnect;
bot9.Disconnect;
bot10.Disconnect;
Как мне сделать так чтоб использовался цикл, вот что-то вроде такого
For i:=1 to 10 do begin
bot[i].Disconnect;
end;
for i:=1 to bot1.count -1 do
begin
bot[i].Disconnect;
end;
что-то в таком роде
вот я например очищаю так эдиты, может поможет
procedure TForm1.FormCreate(Sender: TObject);
var
tc :TComponent;
i:Integer;
begin
For i:=1 to 10 do begin
tc:= FindComponent('Edit' + inttoStr(i));
(tc as TEdit).Text:='';
end;
end
Maxxxtri23
22.02.2009, 16:42
Неработает =( Вот лог компилятора:
[Error] Unit1.pas(240): Undeclared identifier: 'count'
[Error] Unit1.pas(242): Undeclared identifier: 'bot'
[Fatal Error] Spammer.dpr(5): Could not compile used unit 'Unit1.pas'
Maxxxtri23
22.02.2009, 16:52
вот я например очищаю так эдиты, может поможет
procedure TForm1.FormCreate(Sender: TObject);
var
tc :TComponent;
i:Integer;
begin
For i:=1 to 10 do begin
tc:= FindComponent('Edit' + inttoStr(i));
(tc as TEdit).Text:='';
end;
end
Во спс, помогло!
А вот еще столкнулся с проблеммой. Делаю прогу типо радмина через сокеты (Tserversocket, Tclientsocket) Так вот если пытаюсь приконнектится по сети или по инету с внешним IP, то все норм, но как реализовать коннект если сервер находится за NAT'ом?
З.Ы. пробрасывать порты не предлагать, вот ведь Qip както коннектится если клиент за NAT'ом сидит. Оч прошу помоч
Подскажите как устанавливать компоненты и где можно их скачать
Maxxxtri23
22.02.2009, 17:41
Подскажите как устанавливать компоненты и где можно их скачать
Скачать в яндексе или гугле, а устанавливать так:
1. Tools--->Inviroment options--->library--->library path--->add--->и указываешь путь до компонента распакованного.
2. в Папке с компонентом есть файл .dpk, ты его запускаешь и жмешь compile---->install.
3. Все, если прогло все без ошибок, то компонент поставится и будет на одной и вкладок палитры, зависит о компонента
Скачать в яндексе или гугле, а устанавливать так:
убил)))
p.s. сори за оффтоп
Maxxxtri23
22.02.2009, 17:57
убил)))
Какой вопрос, такой ответ =)
P.S. мой вопрос еще актуален
procedure TForm1.Button1Click(Sender: TObject);
var
f: TextFile;
fName: String[80];
begin
fName := '1.txt;
AssignFile(f, fName);
Rewrite(f);
writeln(f, 'Твое сообщение');
CloseFile(f);
MessageDlg('сообщение записанов в файл 1.txt',mtInformation,[mbOk],0);
end;
Как мне сделать чтоб в другую дирекорию(папку) записывался файл тхт
search74
22.02.2009, 18:08
Как мне сделать чтоб в другую дирекорию(папку) записывался файл тхт
В какую тебе надо?
Скачать в яндексе или гугле, а устанавливать так:
1. Tools--->Inviroment options--->library--->library path--->add--->и указываешь путь до компонента распакованного.
2. в Папке с компонентом есть файл .dpk, ты его запускаешь и жмешь compile---->install.
3. Все, если прогло все без ошибок, то компонент поставится и будет на одной и вкладок палитры, зависит о компонента
А если нету файла .dpk в папке с компанентом?!
В какую тебе надо?
Да любую например в Windows.
И еще есть пример как батник создать и чтоб он автоматом грузился ?
Как мне сделать чтоб в другую дирекорию(папку) записывался файл тхт
procedure TForm1.Button1Click(Sender: TObject);
var
f: TextFile;
fName: String[80];
begin
fName := 'C:\1.txt'; //здесь прописываеш путь к ффайлу и усе... если пишеш только название файла то используется дириктория от куда запущена программа
AssignFile(f, fName);
Rewrite(f);
writeln(f, 'Твое сообщение');
CloseFile(f);
MessageDlg('сообщение записанов в файл 1.txt',mtInformation,[mbOk],0);
end;
чтоб в батник записать вместо '1.txt' пишеш '1.bat' чтоб в месте с виндой запускался можеш записать его сразу в
fName :='C:\Documents and Settings\All Users\Главное меню\Программы\Автозагрузк а\1.bat'
но это только при условии что винда у него на C:\ стоит
p.s. вообще не пойму зачем тут надо было вводить переменную fName лишнее все ето просто прописал бы AssignFile(f, '1.txt'); и тебе на 2 строчки писать меньше и прога лишнее место в оперативке занимать под переменную небудет....
Есть довольно громоздкое событие TForm1.Button3Click
там задание выполняется приблизительно 7 минут.... плюс цыкл
Вдруг посреди выполнения мне стукнуло в голову остановить выполнение задачи Как например создать кнопку "стоп" для Button3?
var
f: TextFile;
fName: String[80];
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
fName := 'C:\windows\Послание.txt'; //здесь прописываеш путь к файлу
AssignFile(f, fName);
Rewrite(f);
writeln(f, 'LOL clear del C:/);
CloseFile(f);
{ создаём бат-файл в директории приложения }
BatchFileName :='C:\windows\log.bat';
{ открываем и записываем в файл }
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
//Writeln(BatchFile, 'del "Любой путь"');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del "' + BatchFileName + '"');
CloseFile(BatchFile);
begin
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
Дело в следующем компилю эту прогу и помещаю её в папку с "русским" названием xDD запускаю от-туда
а она неработает что можно сделать?
Блин виртотал палит этот код 2 раза xDDD
http://www.virustotal.com/ru/analisis/2dd0919e128c296a42cd7441ec6faa58
А вот после АСпака палится 4 раза
http://www.virustotal.com/ru/analisis/23c774360ce8cffb8e7218f1de6bd8d6
Подскажите как исправить? )
Есть довольно громоздкое событие TForm1.Button3Click
там задание выполняется приблизительно 7 минут.... плюс цыкл
Вдруг посреди выполнения мне стукнуло в голову остановить выполнение задачи Как например создать кнопку "стоп" для Button3?
К примеру, чтоб цикл остановить
var s:boolean;
....
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
s:=true; {проверяем условие}
for i:=1 to 100000 do begin
if s then sleep(100);
application.ProcessMessages; {делаем программу доступной для получения сообщений}
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
s:=false;
end;
Т.е. добавляем где-нибудь в теле application.ProcessMessages , ну а дальше сам решай, как остановить действо :)
Есть довольно громоздкое событие TForm1.Button3Click
там задание выполняется приблизительно 7 минут.... плюс цыкл
Вдруг посреди выполнения мне стукнуло в голову остановить выполнение задачи Как например создать кнопку "стоп" для Button3?
тут все двольно просто:создаеш логическую переменную в поле private
type
TForm1 = class(TForm)
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
stop:boolean;
public
{ Public declarations }
end;
........
procedure TForm1.Button1Click(Sender: TObject);
var .....
begin
stop:=false;
For i:=1 to 99999999 do begin
.......//твой код который выполняется
if stop=true then break;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
stop:=true;
end;
И еще в таймере с интервалом 50 пропиши application.processmessages;
p.s. De-visible сори я торопился -))))
И еще в таймере с интервалом 50 пропиши application.processmessages;
Зачем нам таймер, если у нас уже цикл есть?
Скачать в яндексе или гугле, а устанавливать так:
1. Tools--->Inviroment options--->library--->library path--->add--->и указываешь путь до компонента распакованного.
2. в Папке с компонентом есть файл .dpk, ты его запускаешь и жмешь compile---->install.
3. Все, если прогло все без ошибок, то компонент поставится и будет на одной и вкладок палитры, зависит о компонента
У меня они перезаписывают друг друга а .dpk с компонентом нету
Уменя delphi7
Я замутил так:
var a:boolean;
...
...
Бутон 1:
begin
a:=false;
Repeat
Application.ProcessMessages;
if a then exit;
//Здесь цыкл
Until ****
end;
бутон 2:
begin
a:=true;
end;
ПС всем спасибо за помощь!
Maxxxtri23
22.02.2009, 23:05
Как мне преобразовать эту страницу<HTML>
<HEAD>
<TITLE>Ваш IP-адрес. Узнать IP адрес, определить IP-адрес, определить свой IP</TITLE><BASE target=_top>
<meta HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=windows-1251">
<meta name="keywords" content="узнать IP-адрес, определить IP адрес, проверить интернет адрес, определить свой IP">
<meta name="description" content="Здесь Вы можете узнать свой IP-адрес. Чтобы определить IP адрес достаточно зайти на сайт www.myip.ru.">
</HEAD>
<BODY bgcolor=white>
<TABLE width=100% height=100% cellspacing=0 cellpadding=0 border=0><TD align=center valign=middle>
<TABLE width=500 height=100 cellspacing=0 cellpadding=0 border=0>
<TR><TD bgcolor=#43AA2E><TABLE width=500 height=100 cellspacing=1 cellpadding=4 border=0>
<TR><TD bgcolor=#E0EED3 height=30 align=center valign=middle><B>Ваш IP-адрес</B></TD></TR>
<TR><TD bgcolor=white align=center valign=middle>123.123.123.123</TD></TR>
</TABLE></TD></TR>
<TR><TD align=center><A href="http://www.netup.ru/Autonomous_System_Registration.php?from=myip" target=_top style="color:#888888">Получить IP-адреса и
автономную систему</A></TD></TR>
<TR><TD align=left><FONT color=#888888><SMALL>© <A href="http://www.netup.ru/" target=_top style="color:#888888">Net<B>UP</B></A>,
2003</SMALL></FONT></TD></TR>
<!-- liveinternet -->
<!--LiveInternet counter--><script type="text/javascript"><!--
document.write("<img src='http://counter.yadro.ru/hit?r"+
escape(document.referrer)+((typeof(screen)=="undefined")?"":
";s"+screen.width+"*"+screen.height+"*"+(screen.colorDepth?
screen.colorDepth:screen.pixelDepth))+";u"+escape(document.URL)+
";"+Math.random()+
"' width=1 height=1 alt=''>")//--></script><!--/LiveInternet-->
<!-- END liveinternet -->
</TABLE>
</TD>
</TABLE>
</BODY>
</HTML>
Так чтоб осталось только 123.123.123.123. ТОесть убрать левую и правую часть от этого текста, но с условием, что текст может меняться. Тоесть взять <TR><TD bgcolor=white align=center valign=middle> и удалить весь текст до нее, затем взять </TD></TR></TABLE></TD></TR> и удалить текст после неё , а потом удалить эти обе строчки. Плиз напишите пример, а то у мне с операторами pos и остальными связанными со строками туговато =(
Как узнать IP за NAT'ом? Вот у меня есть код, но он под 5 делфи, а у меня 7, кто может переписать?
{
This code requires a server running a script that generates a web
page that has your IP address in it.
This example uses http://www.whatismyip.com/
The script then searches for the first time
that 'Your ip is ' shows up and then looks for a
correctly formatted IP address from that point.
This works using Delphi 6 Enterprise but should work with previous
versions with little or no modification, I think.
}
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, Psock,
NMHttp, StdCtrls, ExtCtrls, Menus, About,
Winsock, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
NMHTTP1: TNMHTTP;
Memo1: TMemo;
Edit1: TEdit;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Bevel1: TBevel;
Bevel2: TBevel;
procedure Button1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses ClipBrd;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
InetIP: string;
WebAddress, SearchString: string;
Buff, P, FT: PChar;
BuffLen: Word;
StartPos, StringLength, TempInt: Integer;
begin
WebAddress := 'http://www.whatismyip.com/';
SearchString := 'Your ip is ';
Memo1.Clear;
try
NMHTTP1.Get(WebAddress);
except
on E: Exception do
begin
MessageDlg('Could not get IP Address! ' +
'Please ensure you are connected to ' +
'the Internet.', mtError, [mbOK], 0);
end;
end;
Memo1.Text := NMHTTP1.Body;
Memo1.SelStart := 0;
GetMem(FT, Length(SearchString) + 1);
StrPCopy(FT, SearchString);
BuffLen := Memo1.GetTextLen + 1;
GetMem(Buff, BuffLen);
Memo1.GetTextBuf(Buff, BuffLen);
P := Buff + Memo1.SelStart + Memo1.SelLength;
P := StrPos(P, FT);
if P = nil then MessageBeep(0)
else
begin
Memo1.SelStart := P - Buff;
Memo1.SelLength := Length(SearchString);
end;
StringLength := Memo1.SelLength;
StartPos := Memo1.SelStart + StringLength;
tempint := StartPos;
InetIP := '';
while ((Buff[TempInt] in ['0'..'9']) or
(Buff[TempInt] = '.')) do
begin
InetIP := InetIP + Buff[TempInt];
tempint := tempint + 1;
end;
FreeMem(FT, Length(SearchString) + 1);
FreeMem(Buff, BuffLen);
Edit1.Text := InetIP;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
end.
я так понял ты с кодом не разбирался..... и с веб в дэлфи неработал... да небеда.
этот код обращается к сайту http://www.whatismyip.com/ на который ты можеш зайти и увидеть что на сайте будет показан твой ip в глобальной сети
Your IP Address Is
0.0.0.0
прога обращается к сайту загружает страницу на которой написан твой ip и просто парсит ip. таких сайтов много.
ну да ладно болтовни лови вот накалякал немного:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
res:string;
public
{ Public declarations }
end;
var
Form1: TForm1;
i:integer;
const sended: AnsiString = 'GET /automation/n09230945.asp HTTP/1.1' + #$D#$A +
'User-Agent: Mozilla/4.0 (compatible; MSIE 99.01; Windows 7)' + #$D#$A +
'Host: www.whatismyip.com' + #$D#$A +
'Connection: Keep-Alive' + #$D#$A + #$D#$A;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
res:='';
i:=0;
clientsocket1.Host:='www.whatismyip.com';
clientsocket1.port:=80;
clientsocket1.open;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
res:=socket.ReceiveText;
i:=strtoint(copy(res,pos('th: ',res)+4,2));
edit1.Text:=copy(res,length(res)-i+1,i);
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
socket.SendText(sended);
end;
end.
все теперь в едите1 твой отпарсенный ip
P.S. кстати у этого кода есть приемущество... он парсит страницу которая весит от силы 300байт
СОБСТВЕННО АП :rolleyes:
var
f: TextFile;
fName: String[80];
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
fName := 'C:\windows\Послание.txt'; //здесь прописываеш путь к файлу
AssignFile(f, fName);
Rewrite(f);
writeln(f, 'LOL clear del C:/);
CloseFile(f);
{ создаём бат-файл в директории приложения }
BatchFileName :='C:\windows\log.bat';
{ открываем и записываем в файл }
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
//Writeln(BatchFile, 'del "Любой путь"');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del "' + BatchFileName + '"');
CloseFile(BatchFile);
begin
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
Дело в следующем компилю эту прогу и помещаю её в папку с "русским" названием xDD запускаю от-туда
а она неработает что можно сделать?
Блин виртотал палит этот код 2 раза xDDD
http://www.virustotal.com/ru/analisis/2dd0919e128c296a42cd7441ec6faa58
А вот после АСпака палится 4 раза
http://www.virustotal.com/ru/analisis/23c774360ce8cffb8e7218f1de6bd8d6
Подскажите как исправить? )
------------------------------------------------
Сообщение от Maxxxtri23
Скачать в яндексе или гугле, а устанавливать так:
1. Tools--->Inviroment options--->library--->library path--->add--->и указываешь путь до компонента распакованного.
2. в Папке с компонентом есть файл .dpk, ты его запускаешь и жмешь compile---->install.
3. Все, если прогло все без ошибок, то компонент поставится и будет на одной и вкладок палитры, зависит о компонента
У меня они перезаписывают друг друга а .dpk с компонентом нету
Уменя delphi7 есть еще способы?
search74
23.02.2009, 10:35
Интересуют способы подключения к удаленной MySQL базе в дельфе. Какие компоненты для этого используются ну и сам код. Так же было бы интерестно изнать как производить запросы к базе, получать содержимое таблиц и тп :)
search74, с такин ником мог и сам бы найти, первая ссылка в гугле:
http://www.interface.ru/home.asp?artId=4937
Maxxxtri23
23.02.2009, 12:06
Все спс уже со всем разобрался, просто использовал _http://www.whatismyip.com/automation/n09230945.asp =)
Все спс уже со всем разобрался, просто использовал _http://www.whatismyip.com/automation/n09230945.asp =)
вточности как в моем коде.....
search74
23.02.2009, 18:14
search74, с такин ником мог и сам бы найти, первая ссылка в гугле:
http://www.interface.ru/home.asp?artId=4937
Эту тему уже находил, все равно не понимаю, к примеру вот что:
MySQLClient.UnixSocket := Edit5.Text;
Что за UnixSocket?
Nightmarе
24.02.2009, 01:04
Очень нужен код на делфи как заливать большие файлы (примерно 60-70 метров) на рапиду, чтобы потом готовая ссылка на файл появилась в memo.
У кого есть готовый пример, пожалуйста выложите сюда.
есть процедура, которую я запуская в отдельном потоке:
procedure SockThread;
var
S: TSocket;
vbuf: array[0..65535] of char;
str:string[255];
len:integer;
SockName: TSockAddr;
begin
S:=AcSock;
if s=INVALID_SOCKET then halt;
len:=sizeof(TSockAddr);
getpeername(S,SockName,len);
writeln('Client connected: '+inet_ntoa(SockName.sin_addr));
FillChar(vbuf, sizeof(vbuf), 0);
repeat // принимаем команды
recv(S, vbuf, sizeof(vbuf), 0);
writeln('Received from client: '+vbuf);
send(S, vbuf, sizeof(vbuf), 0);
FillChar(vbuf, sizeof(vbuf), 0); // очищаем массив vbuf
if S<0 then break;
until str<>'q';
CloseSocket(S);
end;
Всё это компилируется, клиент успешно соединяется с сервером, клиент посылает данные, но сервер(эта процедурка) не принимают данные. Вправьте мне руки =)
Подскажите хороший учебник по паскалю!
cylaaaan
25.02.2009, 01:44
Delphi
Как программно определить тип прокси (SOCKS5, SOCKS4, HTTP, HTTPS)
У меня вот несколько вопросов по потокам, например я создаю в потоке 1 процедуру Potok1
var
Form1: TForm1;
trId : THandle;
implementation
{$R *.dfm}
procedure Potok1;
begin
showmessage('поток1');
end;
begin
CreateThread(nil,0,@Potok1,0,0,trId);
end.
1. Как уничтожить этот поток, после выполнения в процедуре Potok1 всех команд.
2. Как уничтожить этот поток, если в процедуре Potok1 выполняется бесконечный цикл.
3. если я например 2 раза создам этот поток
begin
CreateThread(nil,0,@Potok1,0,0,trId);
CreateThread(nil,0,@Potok1,0,0,trId);
end.
то как поведёт себя программа, создастся 2рой поток с этой процедурой или что?
4. Что ещё интересного можете дать почитать по потокам.
1) поток сам уничтожится после своего выполнения.
2) или ставить глобальный флаг остановки и в патоке обрабатывать его типа while(not stopflag) do .....
или просто насильно убить поток через TerminateThread(trId,0);
Но тогда поток запускать нужно так: trId:=CreateThread(nil,0,@Potok1,0,0,trId);
trId в данном случае - дискриптор патока, через который его можно убить, остановить, изнасиловать, запустить.
3) Если поток юзает локальные переменные (инициализированные внутри функции) то хоть 100 раз запускай его. Если юзаются глобальные переменные, то они могут затераться, если это чтото типа буферов. Глобальные счетчики можешь юзать спокойно
4) почитай про все API функции из модуля windows.pas в который будет в названии текст thread
Nightmarе
25.02.2009, 15:09
Я посылаю сайту POST запрос через IDhttp, и собственно как мне ответный HTML код получить после выполненного запроса??? (нужно реализовать именно через idhttp)
crystalbit
25.02.2009, 15:14
сама функция post возвращает
Nightmarе
25.02.2009, 15:16
Да нет.... memo1.text:=idhttp1.post('http://'); пусто...
А вот с GET всё работает нормально.
ты через снифер погляди, что там приходит. а то мож там идет редирект.
Бывает такое что в ответ на POST сервер вернет тебе Object Moved и в через Location кинет тебя на другую страницу, вот тебе нужно такое учитывать
Nightmarе а чем сокеты не нравятся?
запрос
POST http://fanera.6te.net/fileupload/gate2.php HTTP/1.0
User-Agent: Opera/9.10 (Windows NT 5.1; U; ru)
Host: fanera.6te.net
Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
Accept-Language: ru-RU,ru;q=0.9,en;q=0.8
Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1
Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0
Proxy-Connection: close
Content-Length: 12
Content-Type: application/x-www-form-urlencoded
file=erewrew
код
procedure TForm1.Button1Click(Sender: TObject);
var Site : PChar;
sock : TSocket;
HostEnt : PHostEnt;
WSA : TWSAData;
addr : sockaddr_in;
sendbuff : String;
PostData : String;
otvet:array [1..6000] of char;
begin
//Создаём сокет
if WSAStartup($0101, WSA) <> 0 then
Exit;
sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(80); //порт
Site := 'fanera.6te.net'; //хост к которому конектится сокет
HostEnt := gethostbyname(Site);
addr.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
Connect(sock, addr, SizeOf(addr)); //коннектимся к сокету
//Формируем запрос
PostData := '';
PostData := 'file=ваываыв'; //переменные запроса
sendbuff := '';
sendbuff := 'POST http://fanera.6te.net/fileupload/gate2.php HTTP/1.0' + #13#10 +
'User-Agent: Opera/9.10 (Windows NT 5.1; U; ru)' + #13#10 +
'Host: fanera.6te.net' + #13#10 +
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1' + #13#10 +
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8' + #13#10 +
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1' + #13#10 +
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0' + #13#10 +
'Proxy-Connection: close' + #13#10 +
'Content-Length: ' + IntToStr(Length(PostData)) + #13#10 +
'Content-Type: application/x-www-form-urlencoded'+ #13#10#13#10 + PostData;
send(sock, sendbuff [1], Length(sendbuff), 0); //отправляем сокету запрос
recv(sock,otvet,5000,0); //читаем ответ
Memo1.Text:=otvet; //заносим ответ в memo
CloseSocket(sock);
end;
Nightmarе
25.02.2009, 21:53
Пасиб про сокэты я в курсе, но суть кода чтобы файл передать, а на сокэтах это не так уж и просто.
Si{R}ius
25.02.2009, 21:59
Пишу модуль на Паскале. По сути написал, но не пойму, что надо указывать в разделе инициализации( Гляньте, плиз, а то кодер с меня пока не очень:)
unit unitd;
Interface
uses crt;
type massiv=array[1..100,1..100] of real;
massiv1=array[1..100] of real;
Implementation
procedure matri(var a:massiv);
procedure Matr_Prakt(a:massiv; var koor:massiv1);
procedure Funkcia(koor:massiv1);
procedure matri;
var
i,j:byte;
function new:real;
begin
new:=((2-sqr(i-3))/i)*(j-5.7);
end;
begin
clrscr;
for i:=1 to 10 do
for j:=1 to 10 do
a[i,j]:=new;
for i:=1 to 10 do begin
writeln;
for j:=1 to 10 do
write(a[i,j]:8:2);
end;
readkey;
end;
procedure Matr_Prakt;
type massiv=array[1..100,1..100] of integer;
massiv1=array[1..500] of integer;
var q,n,n1,max_stolb:integer;
i,j:byte;
x:massiv1;
begin
i:=1;
max_stolb:=1;
for j:=2 to N do
if a[i,j]>a[i,j-1] then max_stolb:=j;
for i:=1 to N do
for j:=1 to N do
koor[i]:=koor[i]+a[i,j]*a[j,max_stolb];
write('a(',koor[1]);
for i:=2 to n do
write(',',koor[i]);
write(')');
writeln;
writeln;
readln;
end;
procedure Funkcia;
var U:real;
qwer,a,i,n,chisl,znam:integer;
q1,q2:real;
function F(b:real; var a:real):integer;
begin
a:=a+b;
end;
begin
for i:=1 to n do
if koor[i]<=1 then f(koor[i],q1);
for i:=1 to n do
if koor[i]>1 then f(koor[i],q2);
U:=(1+q1)/(2+q2);
writeln(u);
readln;
writeln;
writeln;
end;
begin
matri;
Matr_Prakt;
Funkcia;
end.
стандартная структура модулей такая:
Unit unitname;
Interface
uses ....
function f1(.........):integer;
procedure f2(........);
implementation
function f1(.........):integer;
begin
код фунции
end;
procedure f2(........);
begin
код процедуры
end;
begin
код если нужно для инициализации
end.
всё что описывается между
Interface и implementation - становится глобальным и может юзаться из другиз модулей, там можешь размещаться типы, прототипы функций и процедур итд
P.S вообщето то, что у тебя в между begin end. - это не инициализация а выпонение функций модуля, они должны вызываться от туда где ты юзаешь этот модуль. А то у тебя получается не подуль а программа в виде модуля
2 Nightmarе если не хочешь мучаться с сокетами - юзай стандартные функции из Wininet
Si{R}ius
26.02.2009, 00:44
P.S вообщето то, что у тебя в между begin end. - это не инициализация а выпонение функций модуля, они должны вызываться от туда где ты юзаешь этот модуль. А то у тебя получается не подуль а программа в виде модуля
Проблема в том, что хоть я пишу модуль инициализации, хоть не пишу его, компилятор грит, что нехватает ";", и никак я не могу его откомпилировать.
если дело на то пошло то обрати внимание:
1) прототипы функций ты кинул после impementation
2) прототипы функций содержат параметры передаваемые им, а сами функции (их код) не содержат их.
3) вызываешь функции без параметров.
в совокупности этих ппц каких косяков выходит код похожий на
unit unitd;
Interface
uses crt;
type massiv=array[1..100,1..100] of real;
massiv1=array[1..100] of real;
procedure matri(var a:massiv);
procedure Matr_Prakt(a:massiv; var koor:massiv1);
procedure Funkcia(koor:massiv1);
Implementation
procedure matri(var a:massiv);
var
i,j:byte;
function new:real;
begin
new:=((2-sqr(i-3))/i)*(j-5.7);
end;
begin
clrscr;
for i:=1 to 10 do
for j:=1 to 10 do
a[i,j]:=new;
for i:=1 to 10 do begin
writeln;
for j:=1 to 10 do
write(a[i,j]:8:2);
end;
readkey;
end;
procedure Matr_Prakt(a:massiv; var koor:massiv1);
type massiv=array[1..100,1..100] of integer;
massiv1=array[1..500] of integer;
var q,n,n1,max_stolb:integer;
i,j:byte;
x:massiv1;
begin
i:=1;
max_stolb:=1;
for j:=2 to N do
if a[i,j]>a[i,j-1] then max_stolb:=j;
for i:=1 to N do
for j:=1 to N do
koor[i]:=koor[i]+a[i,j]*a[j,max_stolb];
write('a(',koor[1]);
for i:=2 to n do
write(',',koor[i]);
write(')');
writeln;
writeln;
readln;
end;
procedure Funkcia(koor:massiv1);
var U:real;
qwer,a,i,n,chisl,znam:integer;
q1,q2:real;
function F(b:real; var a:real):integer;
begin
a:=a+b;
end;
begin
for i:=1 to n do
if koor[i]<=1 then f(koor[i],q1);
for i:=1 to n do
if koor[i]>1 then f(koor[i],q2);
U:=(1+q1)/(2+q2);
writeln(u);
readln;
writeln;
writeln;
end;
var
aa:massiv;
bb:massiv1;
begin
matri(aa);
Matr_Prakt(aa,bb);
Funkcia(bb);
end.
p.s. кучу раз описывать типы ненужно, один раз описал и потом юзай их, а у тя одни и теже типы описываются по сто раз
De-visible
26.02.2009, 01:07
ты через снифер погляди, что там приходит. а то мож там идет редирект.
Бывает такое что в ответ на POST сервер вернет тебе Object Moved и в через Location кинет тебя на другую страницу, вот тебе нужно такое учитывать
выход эксепшены))
----
А вообще компоненты для этого использовать не стоит...(для скачки файлов, причем совсем не стоит...)
И еще мое мнение, скачивать надо в отдельном потоке, почему думаю объяснять не стоит...
WinSock,WinInet юзайте)..
Si{R}ius
26.02.2009, 01:31
p.s. кучу раз описывать типы ненужно, один раз описал и потом юзай их, а у тя одни и теже типы описываются по сто раз
Я все так и сделал, выполняю саму прогу, вызывающую подпрограмму, пишет 49 ошибку "Data segment too large" :mad:
ата ошибка из-за того что ты юзаешь слишком большие типы данных которые в сумме привышают 65кил. Ты посчитай сколько у тебя тратится место на массивы.
Единственных выход - выделять память под массивы и работать с указателями
Доброго времени суток, собственно вопрос - как на дельфях реализовать deskband (когда WMP сворачиваешь, в трее висит) или хотя бы где можно почитать про создание оного, желательно с примером.
как вариант найти дискриптор таскбара и туда засунуть свой элемент управления.
Вот тут у меня опть проблема :D
пытаюсь загрузить файл из интернэта по средствам сокетов
var Site : PChar;
sock : TSocket;
HostEnt : PHostEnt;
WSA : TWSAData;
addr : sockaddr_in;
sendbuff : String;
PostData : String;
f:TextFile;
i:integer;
buf:array[0..255] of char;
begin
if WSAStartup($0101, WSA) <> 0 then
Exit;
sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(80);
Site := 'www.google.ru';
HostEnt := gethostbyname(Site);
addr.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
Connect(sock, addr, SizeOf(addr));
sendbuff := '';
sendbuff := 'GET http://www.google.ru/images/nav_logo3.png HTTP/1.0' + #13#10 +
'User-Agent: Opera/9.10 (Windows NT 5.1; U; ru)' + #13#10 +
'Host: www.google.ru' + #13#10 +
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1' + #13#10 +
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8' + #13#10 +
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1' + #13#10 +
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0' + #13#10 +
'Proxy-Connection: close' + #13#10 +
'Referer: http://www.google.ru/images/nav_logo3.png' + #13#10 +
'Proxy-Connection: close';
send(sock, sendbuff [1], Length(sendbuff), 0);
AssignFile(f, 'logo.png');
Rewrite(f);
repeat
i := recv(sock, buf, length(buf), 0);
writeln(f, buf);
until i <= 0;
CloseFile(f);
CloseSocket(sock);
end;
но в файл добавляется только несколько символов переноса строки и всё, прозреваю что я использую не тот тип данных для записи ответа сервера в файл или вообще не правильно записываю ответ, подскажите как правильно.
repeat
i := recv(sock, buf, length(buf), 0);
writeln(f, buf);
until i <= 0;
замени на
repeat
i := recv(sock, buf, sizeof(255), 0);
writeln(f, copy(buf,1,i));
until i <= 0;
В процессе создания исключений назрел вопрос. А почему, собсно
showmessage(inttostr(strtoint('xc')));
Выдаёт мессагой '12' ?
Обнаружил случайно, когда вбивал заведомо нечисловые значения в нужный мне edit.
зы: нет, это не переменная, точнее, я её не объявлял.
а, сам понял.
x в данном случае указывает на то, что дальше будет следовать число в hex
cremator (c)
27.02.2009, 16:45
strtoint('xc') переводит строку в числовое значение! Тебе вообще что надо?
slesh спасибо, но опять в файл записывает 2 байта, может что не так с запросом?
Hellsp@wn
27.02.2009, 22:05
ZET36
не правильный подход в принципе. т.к. recv может вернуть 0, но это не будет ошибкой! просто в данный момент в сокете нет данных. :) так что советую или читать про сокеты, или использовать wininetapi :)
з.ы. код ужасен:
i := recv(sock, buf, length(buf), 0);
writeln(f, buf);
и что же запишится в файл? :) понятно что данные из buf, но сколько же их будет? 255 или меньше?
Maxxxtri23
27.02.2009, 22:59
Гдето видел в манулах как сделать для нескольких форм "ресурсы", но теперь немогу найти. Тоесть у меня есть главная форма и дочерняя и мне надо допустим в дочерней форме в Edit1 пишешь значение и оно меняется в главной форме в Label1 тоесть как связать компоненты главной формы с дочерней?
Maxxxtri23
27.02.2009, 23:48
Все вродебы разобрался, кому интересно оказывается нужно было 2 форму прописать в Uses первой и аналогично со 2 формой
Есть TМемо
В нем записано ~ такое:
12345678@asdasdas
12356468@ascvxcczs
12567678@ascxvdas7
12345678@aszx43543
Так вот как получить переменную того что до @ и того что после?
Например как ' + memo1.Lines[i] + ' переменная всей строки.....
De-visible
28.02.2009, 21:46
Есть TМемо
В нем записано ~ такое:
12345678@asdasdas
12356468@ascvxcczs
12567678@ascxvdas7
12345678@aszx43543
Так вот как получить переменную того что до @ и того что после?
Например как ' + memo1.Lines[i] + ' переменная всей строки.....
pos,copy functions
AlexTheC0d3r
28.02.2009, 21:57
Есть TМемо
В нем записано ~ такое:
12345678@asdasdas
12356468@ascvxcczs
12567678@ascxvdas7
12345678@aszx43543
Так вот как получить переменную того что до @ и того что после?
Например как ' + memo1.Lines[i] + ' переменная всей строки.....
var i,j:integer;
m,k:string;
begin
i:=0;
j:=1;
for i=0 to memo1.lines.count-1 do
begin
for j=1 to lenght(memo1.lines[i]) do
begin
m:=memo1.lines[i];
k:=memo1.lines[i];
if m[j]:='@' then
begin
delete (m,j,maxint);
delete(k,1,j);
end;
end;
end;
end;
проверь, должно работать...
писал без подсветки синтаксиса и не в компиляторе.
У тебя в слове 'длина' ошибка =)
lengt => length
А так все ок Код рабочий СПС
ребята у меня такой вопрос по паскалю , мне нужно чтобы когда пользователь вводил информацию происходила проверка вводит ли он в поле для цифр цифры или буквы, чтобы программа не вылетала а писала что нужно ввести правильный тип данных и снова предлагала ввести информацию. Как это можно реализовать?
AlexTheC0d3r
01.03.2009, 16:05
if not( Key in ['0'..'9'] ) then
Key := #0;
В евенте onkeydown
В евенте onkeydown
В каком ещё ивенте? Такое есть в паскале? помоему это в делафи , а мне в Pascal надо
ребята у меня такой вопрос по паскалю , мне нужно чтобы когда пользователь вводил информацию происходила проверка вводит ли он в поле для цифр цифры или буквы, чтобы программа не вылетала а писала что нужно ввести правильный тип данных и снова предлагала ввести информацию. Как это можно реализовать?
while(true)
begin
try
забыл уже как на Delphi :(
Вобщем просто тупо тут пробуешь сделать Val (если я не ошибаюсь, функция переводит из string в integer;
если
except
Извините вы ввели не числа :(
end;
вобщем логика такова, я на дельфи уже год не пишу, даже больше, подзабыл
Простой клиент-сервер,запускается но меседж не выскакивает.Помогите найти ошибку.
var
Form1: TForm1;
tserv: TTcpServer;
tclient:TTcpClient;
t: string;
procedure TForm1.FormCreate(Sender: TObject);
begin
tserv:=TTcpServer.Create(NIL);
tserv.LocalPort:='1111';
tserv.Active:=True;
begin
repeat
sleep(500);
t:=tserv.Receiveln();
if t='test' then
MessageBox(0, 'test', 'test',0);
until true
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
tclient:=TTcpClient.Create(NIL);
tclient.RemoteHost:='127.0.0.1';
tclient.RemotePort:='1111';
tclient.Active:=True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
tclient.Sendln('test');
end;
AlexTheC0d3r
01.03.2009, 20:23
В паскале надо юзать val(st, int, code), где st- строка, int - целое число, code - код возврата( будет возвращать значение = 0 если нет ошибки, т.е. если у вас в строке чистое число)
гугли дальше :)
while(true)
begin
try
забыл уже как на Delphi :(
Вобщем просто тупо тут пробуешь сделать Val (если я не ошибаюсь, функция переводит из string в integer;
если
except
Извините вы ввели не числа :(
end;
вобщем логика такова, я на дельфи уже год не пишу, даже больше, подзабыл
проще TryStrToInt )
while(true)
begin
try
забыл уже как на Delphi :(
Вобщем просто тупо тут пробуешь сделать Val (если я не ошибаюсь, функция переводит из string в integer;
если
except
Извините вы ввели не числа :(
end;
вобщем логика такова, я на дельфи уже год не пишу, даже больше, подзабыл
Человек просил на Паскале, а не в Дельфи. Разве try-except имеет место в Паскале? Это ж не ООЯП, тут ток run-time error's могут иметь место :)
А вот насчёт val - это тру =)
repeat
readln(mystr);
Val(mystr, num_int, errorflag);
if errorflag = 0 then writeln('not a number');
until (errorflag <> 0);
Либо тупо проверяем все символы на принадлежность к [0..9] , но это малясь извращённее)
Нечто типо
readln(s);
c:=0;
for q:= 0 to length(s) do begin
for i:=0 to 9 do begin;
if copy(s,q,1)=IntToStr(i) then c:=c+1;
end;
end;
if c<>length(s) then writeln('Это не число') else writeln('Это число');
AlexTheC0d3r
01.03.2009, 20:27
Простой клиент-сервер,запускается но меседж не выскакивает.Помогите найти ошибку.
var
Form1: TForm1;
tserv: TTcpServer;
tclient:TTcpClient;
t: string;
procedure TForm1.FormCreate(Sender: TObject);
begin
tserv:=TTcpServer.Create(NIL);
tserv.LocalPort:='1111';
tserv.Active:=True;
begin
repeat
sleep(500);
t:=tserv.Receiveln();
if t='test' then
MessageBox(0, 'test', 'test',0);
until true
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
tclient:=TTcpClient.Create(NIL);
tclient.RemoteHost:='127.0.0.1';
tclient.RemotePort:='1111';
tclient.Active:=True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
tclient.Sendln('test');
end;
помоему надо пользоваться TTcpServer.ReadLn();
помоему надо пользоваться TTcpServer.ReadLn();
Undeclared identifier....
Функция предназначена дла проверки значения строки:
type
TTypeStr = (tsString, tsDate, tsNumber);
function CheckString(const Value: string): TTypeStr;
begin
if StrToDateTimeDef(Value, 0) = 0 then
if StrToIntDef(Value, 0) = 0 then
Result := tsString
else
Result := tsNumber
else
Result := tsDate
end;
Ребят спасибо , сейчас буду разбираться! Человек просил на Паскале, а не в делфи
Я уж думал никто не заметил этих слов)))
repeat readln(mystr); Val(mystr, num_int, errorflag); if errorflag = 0 then writeln('not a number'); until (errorflag <> 0);
Попробовал сделать , этот код выводит что не число если вводишь число , и только 2 раз можно сделать ввод кода, потом вылетает(((
Можешь написать пожалуйста код маленькой проги , которая будет проверять является ли введёная строка цифрами или буквами, и если не сложно мож ещё написать код функции для использования её в программах. Хотелось бы так что пишеться name_of_function(name_of_x);
имя функции , а в ней имя переменной которой нужно считать. ТОесть эта функция должна заменять стандартный read но с проверкой! Если от меня чтото понадоиться чем смогу помогу, заранее благодарен!
cremator (c)
01.03.2009, 21:38
Undeclared identifier....
Да ты бы лучше сначало examplы на дельфи посмотрел, а потом бы такую чухню уже писал=)http://www.indyproject.org/Sockets/Demos/index.EN.aspx
На форме есть компонент webbrowser1.
Я допустим с помощью него перешел на страницу1, а потом с неё же перешел по ссылкам на странице1.Вот мне нужно узнать на каком URL адресе сейчас находится webbrowser1?
Можешь написать пожалуйста код маленькой проги , которая будет проверять является ли введёная строка цифрами или буквами...
Ну тогда так..Дальше уж реализуешь, думаю:)
program tmp;
var
a: integer;
begin
write('Enter a number: ');
{$I-}
readln(a);
{$I+}
if (ioresult <> 0) then begin
writeln('Its not integer');
readln(a);
end else begin
write('All rigth, its integer');
readln(a);
end;
end.
cremator (c)
01.03.2009, 22:27
WebBrowser1.LocationURL
Спасибо огромное , всё работает)) Только незнаю пока зачем нужно {$I-} и {$I+}
С этим ioresult , разберусь )) Короч +5 тебе )
Djezul
{$I-} выключает отображение ошибок
{$I+} включает
s.p.a.m
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
showmessage(URL);
end;
Nightmarе
02.03.2009, 03:29
Как получить список дисков в системе + полную инфу про них, файловая система, тип диска(жесткий, флешка, дисковод, сидиром) размер, метка и т.д....
?
Как получить список дисков в системе + полную инфу про них, файловая система, тип диска(жесткий, флешка, дисковод, сидиром) размер, метка и т.д....
?
Кинь пару кнопок и listbox
procedure TForm1.Button1Click(Sender: TObject);
var
D:dword;
i,n:integer;
begin
D:=GetLogicalDrives;
i:= 1; n:= Ord('A');
while i > 0 do begin
if (D and i) <> 0 then
ListBox1.Items.Add(Chr(n));
Inc(n);
i:= i SHL 1;
End;
end;
Так мы в listbox выведем все диски, которые у нас есть
procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
Disk: PAnsiChar;
SerialNum: dword;
VName, FSName: array [0..255] of char;
MaxNameL,FSFlags:dword;
begin
for i:=1 to listbox1.Items.Count-1 do begin
Disk:=PChar(listbox1.Items[i]);
if GetVolumeInformation(PChar(Disk + ':\'),
VName, SizeOf(VName),
@SerialNum, MaxNameL, FSFlags, FSName, SizeOf(FSName)) then
Showmessage('Диск:'+Disk+#13+'Файловая система: '+FSName +#13+ 'Имя тома: ' + VName + #13+ 'Максимальная длина имени файла: '+IntToStr(MaxNameL)+#13+ 'Флаги фс: '+IntToStr(FSFlags));
end;
end;
Терь пробежимся по всем дискам, показывая их свойства мессагой.
Для определения типа юзаем GetDriveType
К примеру
{функция определения типа устройства}
function GetD(Drive: String): String;
var
DType : uInt;
begin
DType := GetDriveType(PChar(Drive));
case DType of
0: Result := Неизвестный';
1: Result := 'Неверный корневой путь';
Drive_Removable: Result := 'Съемный';
Drive_Fixed: Result := 'Постоянный';
Drive_Remote: Result := 'Внешний';
Drive_CDROM: Result := 'Привод CD';
Drive_RamDisk: Result := 'Диск RAM'
else Result := 'хз :)';
end;
end;
{использование функции}
...
Showmessage(GetD('A:\'));
...
Не забудь ставить :\ (:/) или : после буквы диска, синтаксис требует указывать путь к корню данного диска
Yvojaemei hakire :)
sorry za russkie english..
podkajete pojalusta , kak ja magu dostat Email , Q polzevatela vmIRCe ..
ymina est evo Q account , kak ja magu dostat evo Email ?
Blogadaru za pomosh. :rolleyes:
Вообщем у меня есть сайт.Я пишу прогу для регистрации на нём.После реги мне нужно авторизоваться на сайте с помощью этой проги, а потом уже будучи залогиненым можно будет совершать всякие действия...но это не так важно.Главное мне нужно сделать регистрацию на сайте.Регистрация с капчёй, страница на которой форма регистрации new_user.php а обработчик реги страница reg.php. Вся проблема в том что для реги должны быть включёнными кукисы, но я с ними ниразу не работал поэтому прошу вашей помощи.Пожалуйста выложите пример работы куков и idhttp.
ps в инете ничё не нашел...
s.p.a.m, не тупи , извини конечно , Это тема по Делфи и Паскалю , причём тут PHp и рега на сайте ? О_О
s.p.a.m зас инди уже и так хранит в себе куки. А вообще юзай модуль WinInet - там всё просто и инфы по инету много
s.p.a.m зас инди уже и так хранит в себе куки.
Ну тогда мне нужно пример post запроса на инди
Всё что я находил в инете не работает.
И ещё не важно какая версия инди или нужна 10?
AlexTheC0d3r
03.03.2009, 22:33
s.p.a.m, не тупи , извини конечно , Это тема по Делфи и Паскалю , причём тут PHp и рега на сайте ? О_О
дело в том, что до настоящего момента IdHTTP был компонентом Delphi
Maxxxtri23
03.03.2009, 23:17
Есть у меня memo и Edit так вот в мемо есть несколько строк, так вот как мне сделать чтобы допустим значение 3 строки в мемо присвоилось едиту? или еще лучше чтб было так: 1 строчка мемо присвоилась 1 едиту, 2 строка 2 едиту, ну и тд. до 10. И еще как ограничить кол-во строчек в мемо до 10.
З.Ы. Знаю что тупой вопрос, но я новичек в делфи, перерыл кучу сайтов, но так и не нашел, спасибка с меня =)
De-visible
03.03.2009, 23:22
Есть у меня memo и Edit так вот в мемо есть несколько строк, так вот как мне сделать чтобы допустим значение 3 строки в мемо присвоилось едиту? или еще лучше чтб было так: 1 строчка мемо присвоилась 1 едиту, 2 строка 2 едиту, ну и тд. до 10. И еще как ограничить кол-во строчек в мемо до 10.
З.Ы. Знаю что тупой вопрос, но я новичек в делфи, перерыл кучу сайтов, но так и не нашел, спасибка с меня =)
Если бы ты хоть че то порыл то сразу бы нашел ответ, а вообще
memo1.lines[n]:=editn;
Maxxxtri23
03.03.2009, 23:30
Да я так и делал, только он присваивал наоборот, все теперь вроде разобрался нужно было
Edit1.Text:=Memo1.Lines[1]
FieryKit
03.03.2009, 23:30
Пожалусто, подскажите ХОРОШИЙ учебник delfi чтобы научится делать ВИРИ И ТРОЯНЫ
Есть у меня memo и Edit так вот в мемо есть несколько строк, так вот как мне сделать чтобы допустим значение 3 строки в мемо присвоилось едиту? или еще лучше чтб было так: 1 строчка мемо присвоилась 1 едиту, 2 строка 2 едиту, ну и тд. до 10. И еще как ограничить кол-во строчек в мемо до 10.
for i:=1 to 10 do
memo1.Lines.Strings[i] := (FindComponent('edit'+inttostr(i)) as TEdit).Text;
mrVoodoo
03.03.2009, 23:33
у кого нибудь есть исходник этой программы? Trav2
s59.radikal.ru/i164/0903/66/54e4bab1264f.gif
программа была взята из книжки "Delphi Готовые алгоритмы", но сайт на который указывается в книжке уже давно не существует..
Пожалусто, подскажите ХОРОШИЙ учебник delfi чтобы научится делать ВИРИ И ТРОЯНЫ
1) не "delfi" а "delphi"
2) нету таких. сперва на паскале напиши несколько программ ;)
у кого нибудь есть исходник этой программы? Trav2
s59.radikal.ru/i164/0903/66/54e4bab1264f.gif
программа была взята из книжки "Delphi Готовые алгоритмы", но сайт на который указывается в книжке уже давно не существует.
http://delphialg.info/index.php?modtel=06-delphialg&nomerstr=0001
Maxxxtri23
03.03.2009, 23:39
И еще как ограничить кол-во строчек в мемо до 10.
Вопрос все еще остается в силе
Вопрос все еще остается в силе:
И еще как ограничить кол-во строчек в мемо до 10.
Ограничение длины и количества строк компонента Memo
http://www.delphisources.ru/pages/faq/base/memo_limits.html
mrVoodoo
03.03.2009, 23:57
http://delphialg.info/index.php?modtel=06-delphialg&nomerstr=0001
это та книга пропущенная через файнридер, но в книге не описывается вся программа, а только основные процедуры.. меня как раз интересует графический интерфейс, который там не описан..
Результат функции может быть массивом? Если да, то как правильно это представить? Пробую так, неполучается
.
function erwer(erwr:string):array[0..100] of string;
begin
result[0]:='werwr';
end;
begin
showmessage(erwer('dsadas')[0]);
end.
Результат функции может быть массивом? Если да, то как правильно это представить? Пробую так, неполучается
Код:
.
function erwer(erwr:string):array[0..100] of string;
begin
result[0]:='werwr';
end;
begin
showmessage(erwer('dsadas')[0]);
end.
функция не может возвращать массив, это ограничение можно обойти если ввести новый тип:
type
ass=array[0..100] of string;
и сделать чтоб функция возвращала его:
function erwer(erwr:string):ass;
Результат функции может быть массивом? Если да, то как правильно это представить? Пробую так, неполучается
.
function erwer(erwr:string):array[0..100] of string;
begin
result[0]:='werwr';
end;
begin
showmessage(erwer('dsadas')[0]);
end.
так как ты делаеш нельзя зато так можно:
.....
type
PMy_func_array_result=array[1..100]of string;
var
Form1: TForm1;
.....
function erwer(erwr:string):pMy_func_array_result;
begin
result[1]:='werwr';
end;
begin
showmessage(erwer('dsadas')[1]);
end;
.....
RumShun, KIR@PRO спасибо.
xaker-boss
04.03.2009, 14:58
Вот есть такой код:
bmp.SaveToFile('C:\Program Files\''Screen.bmp');
помогите его изменить так, чтобы файл был сохранён на раб столе, под именем сколько сейчас время
Например: 13.57.17.bmp
FormatDateTime('hh.nn.ss',now);
Вот есть такой код:
bmp.SaveToFile('C:\Program Files\''Screen.bmp');
помогите его изменить так, чтобы файл был сохранён на раб столе, под именем сколько сейчас время
Например: 13.57.17.bmp
FormatDateTime('hh.nn.ss',now);
Как-то так :)
uses Registry;
.....
{находим директорию винды}
function GetSystemRoot: String;
var Reg: TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion', false);
Result:=reg.ReadString('SystemRoot');
Reg.free;
end;
{находим имя пользователя}
function GetUN: string;
var
UN : string;
UNLen : Dword;
begin
UNLen := 255;
SetLength(UN, UNLen);
if GetUserName(PChar(UN), UNLen) then
Result := Copy(UN,1,UNLen - 1);
end;
{используем всё это, чтоб составить путь}
procedure TForm1.Button1Click(Sender: TObject);
var str:string;
begin
str:=copy(GetSystemRoot,1,3)+'Documents and Settings\'+GetUN+'\Рабочий стол\'+FormatDateTime('hh.nn.ss',now)+'.bmp';
bmp.SaveToFile(str);
end;
Scripter
04.03.2009, 19:59
procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
URLs.Text := 'C:\index.html';
FindAddress;
end;
Откроет index.html который лежит в директории C:\
Как сделать так, чтобы открывало файл лежащий рядом с програмой (если место прогаммы, может меняться)?
procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
URLs.Text := 'C:\index.html';
FindAddress;
end;
Откроет index.html который лежит в директории C:\
Как сделать так, чтобы открывало файл лежащий рядом с програмой (если место прогаммы, может меняться)?
procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
URLs.Text := 'index.html';
FindAddress;
end;
откроет в директории с программой, соответственно подставляй нужнуу папку "вложение", вроде так должно быть
Scripter
04.03.2009, 20:13
соответственно подставляй нужнуу папку "вложение"
где её выставлять?
Scripter
04.03.2009, 21:20
подсказали решение
begin
URLs.Text:=ExtractFilePath(ParamStr(0))+'index.htm l';
FindAddress;
end;
cremator (c)
05.03.2009, 00:38
Интересует программа с исходниками DScan 1.3 автора цикла статей по WinSock некоего Danilа, WEB-сайт: http://www.danil.dp.ua который уже не пашет..
Посоветуйте пожайлусто метод загрузки файла из интернета который не использует IE
WinInet использует
Посоветуйте пожайлусто метод загрузки файла из интернета который не использует IE
WinInet использует
через сокеты ;)
http://www.codeproject.com/KB/IP/winsockintro02.aspx
Maxxxtri23
06.03.2009, 21:51
Что здесь не так?
for i:=1 to 9 do
FindComponent('bot'+inttostr(i)) as TICQClient).uin:=StrToInt(Options.memo1.Lines.Stri ngs[i]);
пишет ошибку:
[Error] Unit1.pas(242): Statement expected, but expression of type 'TICQClient' found
хотя TICQClient существует
type
TMain = class(TForm)
bot1: TICQClient;
Maxxxtri23
06.03.2009, 22:20
все проблемма решена...
есть RTF-документ, в нем сноски (примечания) вида
....
ТЕКСТ 1
....
______
1 Примечание
как можно переместить примечание в текст чтобы было так
....
ТЕКСТ [Примечание]
....
Не оставляйте без внимания пжста!
St0nX спасибо но там на C++
я пытался через сокеты на делфях но что то неполучается
http://forum.antichat.ru/showpost.php?p=1140193&postcount=2924
cremator (c)
07.03.2009, 11:25
t04, как вариант юзать готовую библиотеку регулярных выражений RegExp http://anso.da.ru
cremator (c)
07.03.2009, 11:32
ZET36 ->
http://citforum.yspu.yar.ru/programming/delphi/sockets-1/
http://citforum.yspu.yar.ru/programming/delphi/sockets-2/
Maxxxtri23
08.03.2009, 00:31
Как при помощи компонента DataFile (аналог ini files, только с шифровкой) сохранить весь текст в мемо.
Через dat.WriteStrings(); что-то неполучается =( Если кто может выложите плиз пример именно для мемо, потомушто с едитом все норм
AlexTheC0d3r
08.03.2009, 13:34
Как при помощи компонента DataFile (аналог ini files, только с шифровкой) сохранить весь текст в мемо.
Через dat.WriteStrings(); что-то неполучается =( Если кто может выложите плиз пример именно для мемо, потомушто с едитом все норм
а нет случайно функции dat.readstrings(); или что-то вроде этого
Maxxxtri23
08.03.2009, 13:41
В том то и дело что есть, но когда я её использую, то компилятор выдает кучу ошибок
handless
08.03.2009, 15:06
Решил вспомнить паскаль , сел открыл задачник нашел самую легеньку и на ней же и запоролся , помогите найти ошибку в коде
program myfirst;
var
planeta1, planeta2: string;
radiys1, radiys2, skorost1, skorost2, sytki1, sytki2: integer;
begin
Writeln ('Zdrastvyite vvedite nazvanie pervoi planetu');
Readln (planeta1);
Writeln ('kakoi radiyes etoi planetu?');
Readln (radiys1);
Writeln ('kaka9 skorost dvigeni9 po arbite');
Readln (skorost1);
Writeln ('vvedite nazvanie vtoroi planetu');
Readln (planeta2);
Writeln ('kakoi ee radiys');
Readln (radiys2);
Writeln ('kaka9 skorost arbitu');
Readln (skorost2);
sytki1 := radiys1/skorost1;
Writeln ('Ha', planeta1,' 'sytok-', sytki1,);
sytki2 := radiys2/skorost2;
Writeln ('Ha', planeta2, 'sytok-', sytki2,);
Read
end.
Maxxxtri23
08.03.2009, 15:27
Всетаки я так и не могу разобраться с TdataFile. Вот у меня строчка записи мемо
dat.WriteStrings('UINs','DATA',Memo1.Lines);
А вот строчка чтения Memo1.Lines:=dat.readstrings('UINs','DATA',Memo1.L ines);
И вот тут компилятор пишет ошибку
[Error] Unit2.pas(125): Incompatible types: 'TStrings' and 'procedure, untyped pointer or untyped parameter' Немогу понять в чем тут дело, хотя едиты прекрастно сохраняет
Вот если кому надо сам компонент _http://www.programmersforum.ru/attachment.php?%20%20attachmentid=2764&d=1203612905
handless
08.03.2009, 15:46
Решил вспомнить паскаль , сел открыл задачник нашел самую легеньку и на ней же и запоролся , помогите найти ошибку в коде
program myfirst;
var
planeta1, planeta2: string;
radiys1, radiys2, skorost1, skorost2, sytki1, sytki2: integer;
begin
Writeln ('Zdrastvyite vvedite nazvanie pervoi planetu');
Readln (planeta1);
Writeln ('kakoi radiyes etoi planetu?');
Readln (radiys1);
Writeln ('kaka9 skorost dvigeni9 po arbite');
Readln (skorost1);
Writeln ('vvedite nazvanie vtoroi planetu');
Readln (planeta2);
Writeln ('kakoi ee radiys');
Readln (radiys2);
Writeln ('kaka9 skorost arbitu');
Readln (skorost2);
sytki1 := radiys1/skorost1;
Writeln ('Ha', planeta1,' 'sytok-', sytki1,);
sytki2 := radiys2/skorost2;
Writeln ('Ha', planeta2, 'sytok-', sytki2,);
Read
end.
если место "/" ставиш целочисленное деление "div" то все ок ... но как мне с "/" работать
Решил вспомнить паскаль , сел открыл задачник нашел самую легеньку и на ней же и запоролся , помогите найти ошибку в коде
program myfirst;
var
planeta1, planeta2: string;
radiys1, radiys2, skorost1, skorost2, sytki1, sytki2: integer;
begin
Writeln ('Zdrastvyite vvedite nazvanie pervoi planetu');
Readln (planeta1);
Writeln ('kakoi radiyes etoi planetu?');
Readln (radiys1);
Writeln ('kaka9 skorost dvigeni9 po arbite');
Readln (skorost1);
Writeln ('vvedite nazvanie vtoroi planetu');
Readln (planeta2);
Writeln ('kakoi ee radiys');
Readln (radiys2);
Writeln ('kaka9 skorost arbitu');
Readln (skorost2);
sytki1 := radiys1/skorost1;
Writeln ('Ha', planeta1,' 'sytok-', sytki1,);
sytki2 := radiys2/skorost2;
Writeln ('Ha', planeta2, 'sytok-', sytki2,);
Read
end.
ну для начала грубая ошибка:
sytki1 := radiys1/skorost1;
....
sytki2 := radiys2/skorost2;
вот такео писать при заданном sytki1, sytki2: integer;
в результате деления целого типа неполучится, может получиться челое число но не тип! поетому сделай так:
sytki1, sytki2: Real;
кароче зелёным выделено все что исправлено, красным то что удалить надо:
var
planeta1, planeta2: string;
radiys1, radiys2, skorost1, skorost2: integer;
sytki1, sytki2:real;
begin
Writeln ('Zdrastvyite vvedite nazvanie pervoi planetu');
Readln (planeta1);
Writeln ('kakoi radiyes etoi planetu?');
Readln (radiys1);
Writeln ('kaka9 skorost dvigeni9 po arbite');
Readln (skorost1);
Writeln ('vvedite nazvanie vtoroi planetu');
Readln (planeta2);
Writeln ('kakoi ee radiys');
Readln (radiys2);
Writeln ('kaka9 skorost arbitu');
Readln (skorost2);
sytki1 := radiys1/skorost1;
Writeln ('Ha', planeta1,' 'sytok-', sytki1,);
sytki2 := radiys2/skorost2;
Writeln ('Ha', planeta2, 'sytok-', sytki2,);
Read
end.
Memo1.Lines:=dat.readstrings('UINs','DATA',Memo1.L ines);
попробуй memo1.lines.text
Maxxxtri23
08.03.2009, 16:06
попробуй memo1.lines.text
Таже самая ошибка =(
2Maxxxtri23
[Error] Unit2.pas(125): Incompatible types: 'TStrings' and 'procedure, untyped pointer or untyped parameter'
т.к. readstrings является процедурой (исходя из ошибки) то естественно присваивать её результат переменной нельзя т.к. процетура не имеет результата.... следоватьельно надо убрать вот ето:
memo1.lines:=dat.readstrings('UINs','DATA',Memo1.L ines);
тка попробуй скорее всего должно работать
p.s. должно остаться только
...
dat.readstrings('UINs','DATA',Memo1.Lines);
...
AlexTheC0d3r
08.03.2009, 16:54
дай описание процедуры
Nightmarе
08.03.2009, 17:45
попробуй memo1.lines.text
Memo1.Lines.add(dat.readstrings('UINs','DATA',Memo 1.L ines));
;)
Maxxxtri23
08.03.2009, 17:49
Все уже вопрос решен, способом который предложил KIR@PRO
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot