[ Delphi / Pascal ] — начинающим: задаем вопросы

http://rghost.ru/7w7xKMhSl

 

Куда копать понял спасибо , но если там несколько разделителей <Папка> , # и только
после этого | разделителя переход на новую строку .(Код должен выводить все каталоги и файлы в caption а размер , дату в subitems соответственно)
добавил разделители в Array хотел прогнать еще через один цикл но два цикла поставить не могу

 

Здравствуйте подскажите пожалуйста что неправильно делаю ?

Code:

procedure TForm1.Button1Click(Sender: TObject);
begin
MyThread2:=TMyThread2.Create(False);
MyThread2.Priority:=tpNormal;
end;

procedure TMyThread2.Execute;
begin
Opendialog1.InitialDir := GetCurrentDir;
Opendialog1.Execute;
memo1.Lines.LoadFromFile(opendialog1.FileName);
end;

Файл не хочет открываться сразу при нажатии на кнопку Access Violation

 

А зачем его в потоке открывать?

Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  MyThread:TThread;
begin
Opendialog1.InitialDir := GetCurrentDir;
if openDialog1.Execute then
  begin
  MyThread:=TMyThread.Create(true);
  MyThread.FreeOnTerminate:=true;
  MyThread.Priority:=tpLower;
  MyThread.Resume;
  end;
end;

procedure TMyThread.Execute;
begin
   form1.memo1.Lines.LoadFromFile(form1.opendialog1.FileName);
end;

 

Спасибо ! Просто чтобы было рассчитано на очень большой текст (более 3 млн) !

Code:

procedure TForm1.Button3Click(Sender: TObject);
begin
  MyThread:=TMyThread.Create(False);
  MyThread.Priority:=tpNormal;
end;

procedure TMyThread.Execute;
var
i,j:integer;
begin
S := TStringList.Create;
S2 := TStringList.Create;
s.LoadFromFile('logins.txt');
s2.LoadFromFile('passwords.txt');
for i := 0 to s.Count-1 do begin
for j := 0 to s2.Count-1 do
S.Add(s.Strings[i]+':'+s2.strings[j]);
s.SaveToFile('base.txt');
end;
Showmessage('Gotovo');
end;
end.

Кстати заметил что Tstringlist не справляется с этим =(подскажите пжл как сделать чтобы была возможна работа с большим количеством строк.

 

Способа два: чтение из файла, либо если хватит оперативы, выделяй память, считывай файл в аллоченую область, а затем уже читай из памяти. Хотя по мне, работать с файлом лучше.

 

Я маленько ошибся насчёт Tstringlist его вполне хватило на 8600000 строк больше пока не тестировал.
По сути для моих планов этого достаточно, но всё таки хотелось бы узнать про альтернативу подробнее

 

Что узнавать то? Читаешь из файла, обрабатываешь, читаешь дальше. Задавай конкретные вопросы, получишь конкретные ответы)

 

Вариант удаления дубликатов сначала работал теперь нет хотя вроде и код то не менял =(

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
    TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
//Поток 1
  TMyThread = class(TThread)
    private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  MyThread: TMyThread;
  s1,s2: TStringList;

implementation

{$R *.dfm}

procedure TMyThread.Execute;
var
j:integer;
begin
for j :=s1.Count -1 downto 0 do begin
s1.Duplicates:=dupIgnore;
s2.add(s1.Strings[j]);
end;
S2.SaveToFile('nodup.txt');
Showmessage('true');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
s1 := TStringList.Create;
s2 := TStringList.Create;
s1.LoadFromFile('dup.txt');
if checkbox1.Checked=true then
s1.Sorted := True;
MyThread:=TMyThread.Create(False);
MyThread.Priority:=tpNormal;
end;

end.

 

функция удаления дубликатов(под себя переделай)

Code:

function MThread.duble(const line: string): boolean;
var i:integer;
begin
for i:=0 to Form1.listbox2.Items.Count-1 do
if Form1.listbox2.Items.Strings[i]= line then
begin
  result:=true;
break;
end
else
result:=false;
end;

вызов

Code:

if (not duble(line)) then Synchronize(Synch);

 

Нет мне важно знать в чём у меня ошибка

 

пи#дец, как вы всё любите усложнять, раз уж так хочется с TStringList...

Code:

procedure deleteDup(const FileName: String; const SaveFile: String);
var
  sList: TStringList;
begin
  sList:= TStringList.Create; try
    sList.Duplicates:= dupIgnore;
    sList.Sorted:= true;
    sList.LoadFromFile(FileName);
    sList.SaveToFile(SaveFile);
  finally
    sList.Free;
  end;
end;

 

Спасибо вместо двух Tstringlist можно как оказалось использовать всего один !

 

кто то пробовал постить сообщение с delphi в jivosite на сайтах?

 

Суть такова: имеется форма, на ней Memo, кнопка и канва.
В мемо вводим команды (влево 10, вперед 25, стоять 5 и т.д.), после чего нажимается кнопка и на канве идет графическое отображение всего введенного.
Не могу понять, как увязать команды с этими отображениями/
Команды пишутся в столбик, по одной в строке, т.е. "команда [пробел] цифра", цифра означает расстояние или в качестве стоять/стоп - секунды.
Нужно отрабатывать сначала первую строку, потом вторую и т.д. - по сути получается алгоритм движения на канве заранее прописывается в мемо.

В общем, кто чем сможет...

 

А в чем проблема? Реализуй функции GoRight, GoLeft, Stop которые принимают нужные параметры и перерисовывают в канве что нужно, парси команды из мемо и вызывай соответствующие функции передавая им параметры.

 

подскажите по сокетам в дельфи. что то не как не могу разобратся
как сделать примерно как на пхп,
$fp = fsockopen($url, $port, $errno, $errstr, 15);
$headers = fgets ($fp, 1024);

 

mazaxaka, если чисто на winsocket без всяких оберток, то примерно такой порядок действий:

1. инициализируешь библиотеку WinSocket: WSAStartup($0202, wsaData);
2. Создаешь сокет: hSocket:= WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, 0);
3. Заполняешь структуру TSockAddrIn
4. Пробуешь подключиться к хосту: WSAConnect(hSocket, @SockAddrIn, SizeOf(TSockAddr), nil, nil, nil, nil)
5. Отправляешь какие-то данные: send(hSocket, sendData^, cdDataLen, 0);
6. Получаешь какие-то данные (или не получаешь) через: recv(hSocket, buffer, cdBufferLen, 0)
7. закрываешь сокет: closesocket(hSocket);
8. Ну и в конце работы WSACleanup;

это примерный порядок действий без учета проверок и результатов вызовов тех или иных процедур
Ну и чисто мое мнение, если нет особой необходимости и нужно просто получить какой-то url или нет желания изучать доку по работе с сокетами, то проще юзать уже что-то готовое по работе с сетью, это сохранит как нервы, так и ваше время

 

винсокеты для меня сложновато , я пробовал через ClientSocket и через инди тср, но что то не получается ..

 

если говорить в свете http, то я, в свое время, для чего-то простенького всегда использовал WinInet. у него есть свои плюсы и минусы.
вот кусок с его использованием вырванный из старого проекта:

Code:

.............

uses
  Windows, SysUtils, Variants, Classes, WinInet;

{$DEFINE ANDROID}

const
  QUERY_GET  = 0;
  QUERY_POST  = 1;
  QUERY_HTTPS = 2;

const
{$IFDEF ANDROID}
  DEV_ID = 'ao1mAegmj4_7xQOy';
  ClientName = 'ICQ_Android';
  ClientVersion = 3010;
  buildNumber = 711;
{$ELSE}
  DEV_ID = 'gu19PNBblQjCdbMU';
  ClientName = 'ICQ%20Client%20Key%3Dgu19PNBblQjCdbMU';
  ClientVersion = 6082;
  buildNumber = 6082;
{$ENDIF}

.............

function sendQueryNet(URL: String; const data: String; cdFlag: Integer = 0): String;

implementation

(* WinInet function *)

function getHtmlBody(hReq: HINTERNET): String;
var
  dwBytesAvailable, dwBytesRead: DWORD;
  lpBuff: Pointer;
  S: String;
begin
   dwBytesAvailable:= 0; Result:= '';

   if InternetQueryDataAvailable(hReq, dwBytesAvailable, 0, 0) then begin

     GetMem(lpBuff, dwBytesAvailable);

     if (lpBuff <> nil) then try

       repeat
         if not InternetReadFile(hReq, lpBuff, dwBytesAvailable, dwBytesRead) then Break;
         SetString(S, PChar(lpBuff), dwBytesRead);
         Result:= Result + S;
       until dwBytesRead = 0;

     finally
       FreeMem(lpBuff);
     end;
   end;
end;

function getHost(const P: PAnsiChar): String;
var
   iPos: Integer;
   pStart: PAnsiChar;
begin
   iPos:= 0;
   pStart:= StrPos(P,'://');
   if pStart <> nil then begin
     Inc(pStart, 3);
     while ( (pStart[iPos] <> '/') or (pStart[iPos] = #0) or (pStart[iPos] = ':') ) do Inc(iPos);
     SetString(Result, pStart, iPos);
   end;
end;

function getURL(URL: PAnsiChar): PAnsiChar;
begin
   Result:= StrPos(URL,'://');
   if Result <> nil then begin
     Inc(Result, 3);
     Result:= StrPos(Result,'/');
   end;
end;

function sendQueryNet(const data: String; URL: String; cdFlag: Integer = 0): String;
var
   Header, Host, SendData, reqType: String;
   Session, Connect, hReq: HINTERNET;
   Port: Word;
   dwFlags: DWORD;
   pURL: PAnsiChar;
begin
   Port:= INTERNET_DEFAULT_HTTP_PORT;
   Host:= getHost(PAnsiChar(URL));
   pURL:= getURL(PAnsiChar(URL));

   SendData:= data;

   dwFlags:= INTERNET_FLAG_DONT_CACHE;
   //  if HTTPS
   if ((cdFlag and QUERY_HTTPS) <> 0) then begin

     dwFlags:= dwFlags or INTERNET_FLAG_SECURE or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
          INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or INTERNET_FLAG_KEEP_CONNECTION;  
     Port:= INTERNET_DEFAULT_HTTPS_PORT;
   end;

   Session:= InternetOpen(PAnsiChar(clientName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

   if Assigned(Session) then try

     Connect:= InternetConnect(Session, PAnsiChar(Host), Port, '', '', INTERNET_SERVICE_HTTP, 0, 0);

     if Assigned(Connect) then try

       // Тип запроса
       if ((cdFlag and QUERY_POST) <> 0) then reqType:= 'POST' else reqType:= 'GET';

       if ((cdFlag and QUERY_POST) = 0) then begin
         pURL:= PAnsiChar(pURL + '?' + SendData);
       end;
       
       Header:= 'Accept: text/html, */*'#13#10 +
           'Host: ' + Host + #13#10 +
           'User-Agent: '+ clientName + #13#10 +
           'Connection: close';
       
       if ((cdFlag and QUERY_POST) <> 0) then
       Header:= Format('%s'#13#10'Content-Length: %d'#13#10 +
               'Content-Type: application/x-www-form-urlencoded',
               [Header, Length(SendData)]);

       hReq:= HttpOpenRequest(Connect, PAnsiChar(reqType), pURL, nil, nil, nil, dwFlags, 0);

       if Assigned(hReq) then try
         // is GET request
         if ((cdFlag and QUERY_POST) = 0) then SendData:= '';

         if HttpSendRequest(hReq, PChar(Header), Length(Header), PChar(SendData), Length(SendData)) then
           Result:= getHtmlBody(hReq);
       finally
         InternetCloseHandle(hReq);
       end;
     finally
       InternetCloseHandle(Connect);
     end else raise Exception.Create('Failed call InternetConnect');
   finally
     InternetCloseHandle(Session);
   end else raise Exception.Create('Failed call InternetOpen');
end;

и юзается это примерно так:

Code:

procedure getUrlData()
var
  ans: String;
begin
  // GET запрос http://site.com/index.php?t=148&id=1565
  ans:= sendQueryNet('t=148&id=1565', 'http://site.com/index.php');
 
  // SSL GET запрос https://site.com/index.php?t=148&id=1565
  ans:= sendQueryNet('t=148&id=1565', 'https://site.com/index.php', QUERY_GET or QUERY_HTTPS);
 
  // POST запрос http://site.com/login.php
  // POST data: login=users&password=qwerty
  ans:= sendQueryNet('login=users&password=qwerty', 'http://site.com/login.php', QUERY_POST);
 
  // SSL POST запрос https://site.com/login.php
  // POST data: login=users&password=qwerty
  ans:= sendQueryNet('login=users&password=qwerty', 'https://site.com/login.php', QUERY_POST or QUERY_HTTPS);   
end;