[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

rankor777 · 20 Jun 2008

hexb() мне надо вроде....

Hellsp@wn · 23 Jun 2008

CSCA1 := GetProcAddress(hDll, 'CSCA1');

diznt · 25 Jun 2008

Народ как реализовать так чтобы прога не слишком много жрала памяти (ну то есть по минимуму)

ntldr · 25 Jun 2008

Есть ли функция в Windows API, позволяющая получить текущий каталог?

zl0y · 25 Jun 2008

GetCurrentFolder,но лучше через GetModuleFileNameA(0) и извлечь путь.

0x0c0de · 25 Jun 2008

>>Есть ли функция в Windows API, позволяющая получить текущий каталог?

GetCurrentDirectory и не надо ничего извлекать=)

http://msdn.microsoft.com/en-us/library/aa364934(VS.85).aspx

diznt · 25 Jun 2008

Народ как редактировать реестр с помощью проги к примеру запускаешь прогу и она параметры редактирует

W!z@rD · 25 Jun 2008

unit apiregistry;

interface

uses Windows;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetExpandString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetDWORD(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte): boolean;
function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegValueExists(RootKey: HKEY; Name: string): boolean;
function RegKeyExists(RootKey: HKEY; Name: string): boolean;
function RegDelValue(RootKey: HKEY; Name: string): boolean;
function RegDelKey(RootKey: HKEY; Name: string): boolean;
function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY): boolean;
function RegDisconnect(RemoteKey: HKEY): boolean;
function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string): boolean;

implementation

function LastPos(Needle: Char; Haystack: string): integer;
begin
for Result := Length(Haystack) downto 1 do
if Haystack[Result] = Needle then
Break;
end;

function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY):
boolean;
begin
Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) =
ERROR_SUCCESS);
end;

function RegDisconnect(RemoteKey: HKEY): boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;

function RegSetValue(RootKey: HKEY; Name: string; ValType: Cardinal; PVal:
Pointer; ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
dispo: DWORD;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_WRITE,
nil, hTemp, @dispo) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize)
= ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegGetValue(RootKey: HKEY; Name: string; ValType: Cardinal; var PVal:
Pointer;
var ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
MyValType: DWORD;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) =
ERROR_SUCCESS then
begin
GetMem(Buf, BufSize);
if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize)
= ERROR_SUCCESS then
begin
if ValType = MyValType then
begin
PVal := Buf;
ValSize := BufSize;
Result := True;
end
else
begin
FreeMem(Buf);
end;
end
else
begin
FreeMem(Buf);
end;
end;
RegCloseKey(hTemp);
end;
end;
end;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value)
+ 1);
end;

function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0),
Length(Value) + 2);
end;

function RegSetExpandString(RootKey: HKEY; Name: string; Value: string):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0),
Length(Value) + 1);
end;

function RegSetDword(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end;

function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],
length(Value));
end;

function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
begin
CopyMemory(@Value, Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
begin
SetLength(Value, BufSize);
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegValueExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) =
ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal):
boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
ValType: Cardinal;
begin
Result := False;
Value := REG_NONE;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS)
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil)
= ERROR_SUCCESS);
if Result then
Value := ValType;
RegCloseKey(hTemp);
end;
end;
end;

function RegKeyExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
Result := True;
RegCloseKey(hTemp);
end;
end;
end;

function RegDelValue(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegDelKey(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegEnum(RootKey: HKEY; Name: string; var ResultList: string; const
DoKeys: Boolean): boolean;
var
i: integer;
iRes: integer;
s: string;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
ResultList := '';
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
BufSize := 1024;
GetMem(buf, BufSize);
i := 0;
iRes := ERROR_SUCCESS;
while iRes = ERROR_SUCCESS do
begin
BufSize := 1024;
if DoKeys then
iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
else
iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
if iRes = ERROR_SUCCESS then
begin
SetLength(s, BufSize);
CopyMemory(@s[1], buf, BufSize);
if ResultList = '' then
ResultList := s
else
ResultList := Concat(ResultList, #13#10,s);
inc(i);
end;
end;
FreeMem(buf);
RegCloseKey(hTemp);
end;
end;

function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string):
boolean;
begin
Result := RegEnum(RootKey, Name, ValueList, False);
end;

function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
begin
Result := RegEnum(RootKey, Name, KeyList, True);
end;

end.
Click to expand...

(c) DelphiWorld

krypt3r · 26 Jun 2008

Стандартный модуль Registry есть и тип TRegistry

vspv · 26 Jun 2008

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring

A2GIL · 26 Jun 2008

vspv said:

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring
Click to expand...

Самое большое количество символов, которое можно использовать в Delphi. Нужно создать тип.
Code:
type
  TStr = array[0..1024] of Char;
  LngStr = ^TStr;

var
  Buffer: LngStr;
  ...

  New(Buffer);


  ReadLn(F, Buffer^);
diznt said:

Народ как реализовать так чтобы прога не слишком много жрала памяти (ну то есть по минимуму)
Click to expand...

Читай статьи по оптимизации кода. Можешь в типсах здесь же поискать, как то видел. Пару советов

1) Если ты часто используешь для переменных один и тот же тип, integer, к примеру, то лучше создать тип и потом ссылаться на него

type
myInt = Int64;

...

var
i:myInt;
...

2) Если переменная не становится отрицательной то не зачем ей присваивать значение integer. Присвой лучше word Ну если это переменная счетчака, то как правило присваивают byte.

вообщем все в таком духе..

Dober'man · 26 Jun 2008

A2GIL said:
Самое большое количество символов, которое можно использовать в Delphi. Нужно создать тип.
Code:
type
  TStr = array[0..1024] of Char;
  LngStr = ^TStr;

var
  Buffer: LngStr;
  ...

  New(Buffer);

  ReadLn(F, Buffer^);
Click to expand...
Насколько я понял F у тебя типа text, то как же тогда команда ReadLn, которая считывает из файла строки, укажет строку - адресом одного символа?!?!?!

Сообщение от diznt
Народ как реализовать так чтобы прога не слишком много жрала памяти (ну то есть по минимуму)
Click to expand...

Я писал в типсах про множества...

A2GIL · 26 Jun 2008

Dober'man said:

Насколько я понял F у тебя типа text, то как же тогда команда ReadLn, которая считывает из файла строки, укажет строку - адресом одного символа?!?!?!
Click to expand...

Абсолютно не понял, что ты этим хотел сказать?! В адресную ячейку (Buffer) в которую можно записать 1024 символа и записывается считанная строка. Таким образом в текстовом файле в одной строке содержится максимально 1024 символа и строки поочередно считываются. При этом нужно конечно бы освободать память при переходе на новую строчку. Иначе говоря считывание из текстового файла, в строчках которого достаточно большое кол-во символов может происходить следюущ. образом:
Code:
var
 f:TextFile;
begin
AssignFile(f,'txtfile');
 Reset(f);
while not EOF(f) do
 begin
  new(buffer);
  readln(f,buffer^);

  ....

  dispose(buffer);

 end;
 CloseFile(f);

Dober'man · 27 Jun 2008

A2GIL
Блин...ты сам разберись!!!
Code:
type
  TStr = array[0..1024] of Char;
  LngStr = ^TStr;

var
  Buffer: LngStr;
При таком объявлении память будет выделена ТОЛЬКО ПОД УКАЗАТЕЛЬ (Buffer) (всего 1 байт).

В адресную ячейку (Buffer) в которую можно записать 1024 символа и записывается считанная строка.
Click to expand...

Какие там 1024 символа под строку?!?!?! (и даже не 1024, а 1025)
Ты где такое видел??? =)
В твое примере ты выделил память под 1025 символов!!!!
К ним так buffer^ не обращаются!!! У тебя это и не откомпилируется...
Там циклом все делается...

for i:=0 to 1024 do
begin
read(f, buffer^)
end;
Click to expand...

Это динамически формируемые массивы...

De-visible · 27 Jun 2008

vspv said:

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring
Click to expand...

Нельзя ли прежде, чем задать такой вопрос посмотреть здесь: google.ru, также можно массивом....

/Boom\ · 27 Jun 2008

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.

BlackSun · 27 Jun 2008

/Boom\ said:

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.
Click to expand...

"Как сделать ну вот это, там еще такая штучка, ну вы поняли" ... откуда грузишь? каг грузишь? мы те экстрасенсы?

0verbreaK · 27 Jun 2008

Легче статически сделать, выполнение загрузки путем увеличения с паузой.
Code:
procedure Tform1.Step;
var
  i: Integer;
begin
   ProgressBar1.StepIt;
   Sleep(12);
   ProgressBar1.StepBy(12);
   ProgressBar1.Max:=100;
end;
Загрузка текстового файла
Code:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  if OpenDialog1.Execute then
  begin
    if FileExists(OpenDialog1.FileName) then
    begin
      Step;
      Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
      ProgressBar1.Position:=0;
    end;
  end;
 end;

Snik · 28 Jun 2008

/Boom\ said:

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.
Click to expand...

Имхо, тогда надо использовать на LoadFromFile, а буферизованное чтение из файла, скажем, блоками по 4к, макс прогрессбара установить в размер файла (в кб, скажем) и увеличивать при каждой n-ой итерации (на 4 в данном случае). И не забывать про processmessages после каждого обновления значения.

gh-62 · 28 Jun 2008

С помощью idHttp и CookieManager я авторизуюсь на сайте N, затем запросом http.get("N.ru/нужная страница"); загружаю исходный код запрашиваемой HTML'ки. С этим все отлично.
Вопрос: подскажите пожалуйста в каком направлении копать на пути парсинга загруженной HTML страницы, без TWebBrowser. В частности как получать данные из таблиц с id и class например
HTML:
<table id="mess">
<tr id="qwerty">
<td class="main">...</td>
</tr>
</table>
То бишь, надо выдернуть данные (текст) из содержащих эти классы/айди тегов.

Насколько я понял,нужный парсинг лежит в огороде DOM, а парсить путем Pos("") не особо хочется

По DOM'у, в исходниках везде идет представление WebBrowser.Document как IHTMLDocument2, но можно и без WebBrowser.Document, для этого надо что-то перегонять в IHTMLDocument2, а вот что - без понятия

[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

rankor777 Elder - Старейшина

Hellsp@wn Elder - Старейшина

diznt Elder - Старейшина

ntldr Elder - Старейшина

zl0y Banned

0x0c0de Elder - Старейшина

diznt Elder - Старейшина

W!z@rD Борец за русский язык

krypt3r Elder - Старейшина

vspv New Member

A2GIL Elder - Старейшина

Dober'man Banned

A2GIL Elder - Старейшина

Dober'man Banned

De-visible [NDC] Network develope c0ders

/Boom\ Elder - Старейшина

BlackSun Banned

0verbreaK Elder - Старейшина

Snik New Member

gh-62 New Member

Useful Searches

[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

rankor777 Elder - Старейшина

Hellsp@wn Elder - Старейшина

diznt Elder - Старейшина

ntldr Elder - Старейшина

zl0y Banned

0x0c0de Elder - Старейшина

diznt Elder - Старейшина

W!z@rD Борец за русский язык

krypt3r Elder - Старейшина

vspv New Member

A2GIL Elder - Старейшина

Dober'man Banned

A2GIL Elder - Старейшина

Dober'man Banned

De-visible [NDC] Network develope c0ders

/Boom\ Elder - Старейшина

BlackSun Banned

0verbreaK Elder - Старейшина

Snik New Member

gh-62 New Member