Парсинг txt (WINAPI)

[Алексей_2012]

var TS:Tstringlist;
s:string;
ok:boolean;
i:longint;
begin


s:='';
ok:=false;
showmessage('Введите в TEdit образец искомой строки');

s:=trim(edit1.text);
if (s=='') exit;

TS:=TstringList.create();
ts.loadfromfile('c:\...');

for i:=0 to ts.count-1 do
  if pos(s,ts[i])==1
  begin
  ok:=true;
   //действия
  end;

if (!ok) showmessage('Записей не найдено');

ts.free;
end;

С потолка

[Аватар]

Угу, это уж точно все чистое winapi

[HTTqp]

Tstringlist; все портит


Все пытаюсь оптмизировать код:

var s,s2:ansistring;
      h:THandle; z,i,b,e:Cardinal;
begin
 h:=CreateFile('d:\1\q.txt', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
 if h=0 then exit;
 z:=GetFileSize(h,@i);
 SetLength(s,z);
 ReadFile(h, s[1], Length(s), i, nil);
 //CloseHandle(h);
 b:=1;
 while b<>0 do begin
   b:=pos(#13#10,s); s2:=copy(s,1,b); delete(s,1,b+1);
   s2:=StringReplace(s2,' ','',[rfReplaceAll]);
 end;
 SetLength(s,0);
end;

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

[Stilet]

завтра уже показывать

Спалишься )
Тут из винапишки только чтение файла. А парсить на винапи кто будет?

[Alex11223]

Сообщение от Stilet

"После завтра" ж )

[VladWH]

Сообщение от HTTqp

помоги кому не сложно после завтра уже показывать, а я тут застрял(

вот полностью на WinAPI окно, элементы и парсинг

program WATP;

uses
  Windows,
  Messages;

function PathRemoveFileSpecA(pszPath: PAnsiChar): BOOL;
                                     stdcall; external 'shlwapi.dll';
function StrStrA( const str1, str2: PAnsiChar): LPTSTR;
                                     stdcall; external 'shlwapi.dll';

{$APPTYPE GUI}

var
  hWindow     : HWND;
  WndClass    : TWndClass;
  msgMessage  : TMSG;
  Edit        : HWND;
  Button      : HWND;
  ResEdit     : HWND;
const
  sClassName = 'TXTParsing';
  EditID     = 1;
  ButtonID   = 2;
  ResEditID  = 3;

function GetModuleDirectory: string;
var  Path: array [0..255] of char;
begin
 GetModuleFileName(0, @Path, MAX_PATH);
 PathRemoveFileSpecA(Path);
 result:=Path;
end;

procedure ButtonClick;
var s,s2,url,txt:ansistring; l,l2: integer;
begin
 l := GetWindowTextLength( Edit );
 SetLength(s,l);
 GetWindowText( Edit, PAnsiChar(s), l );
 txt := 'Результат парсинга';
 repeat
  s2 := StrStrA(PAnsiChar(s),'"');
  if s2='' then Break;
  lstrcpyn(@s[1], @s2[2], lstrlen(PAnsiChar(s2)));
  s2 := StrStrA(PAnsiChar(s),'"');
  l2 := lstrlen(PAnsiChar(s))-lstrlen(PAnsiChar(s2));
  SetLength(url, l2+1);
  lstrcpyn(@url[1], @s[1], l2+1);
  if url<>'' then
    begin
     SetLength(txt, lstrlen(PAnsiChar(txt))+lstrlen(PAnsiChar(#13#10+url)));
     lstrcatA(@txt[1], PAnsiChar(#13#10+url));
    end;
  lstrcpyn(@s[1], @s2[2], lstrlen(PAnsiChar(s2)));
 until (url='') or (s2='') or (s='');
SetWindowText( ResEdit, PAnsiChar( txt ) );
end;

procedure LoadFromFile;
var FH: THandle;
FS,FHS: Cardinal;
Str: AnsiString;
begin
FH := CreateFile(PAnsiChar(GetModuleDirectory + '\q.txt'),
                 GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if FH=0 then
 begin
  MessageBox(hWindow, 'Ошибка файла!', '', 0);
  PostQuitMessage(0);
 end;
FS := GetFileSize(FH,@FHS);
SetLength( Str, FS );
ReadFile(FH, Str[1], Length( Str ), FHS, nil);
SetWindowText( Edit, PAnsiChar( Str ) );
CloseHandle(FH);
end;

function ParsWndProc(Window: HWnd; AMessage, WParam,
                          LParam: Longint): Longint; stdcall; export;
var
  AMsg        : TMessage;
  hdcHDC      : HDC;
  PaintStruct : TPaintStruct;
  Rect        : TRect;
begin
  AMsg.Msg := AMessage;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;
  case AMessage of
    WM_PAINT   :  begin
                    hdcHDC := BeginPaint(Window,PaintStruct);
                    GetClientRect(Window,Rect);
                    EndPaint(Window,PaintStruct);
                  end;
    WM_DESTROY :  PostQuitMessage(0);
    WM_COMMAND: begin
                 case LoWord( wParam ) of
                  ButtonID: ButtonClick;
                 end;
                end;
  else ParsWndProc := DefWindowProc(Window, AMessage, WParam, LParam);
    Exit;
  end;
  Result := AMsg.Result
end;

procedure CreateParsWnd;
begin
 WndClass.style := CS_HREDRAW or CS_VREDRAW;
 WndClass.lpfnWndProc := @ParsWndProc;
 WndClass.cbClsExtra := 0;
 WndClass.cbWndExtra := 0;
 WndClass.hInstance  := hInstance;
 WndClass.hIcon      := LoadIcon(0,IDI_APPLICATION);
 WndClass.hCursor    := LoadCursor(0,IDC_ARROW);
 WndClass.hbrBackground := HBRUSH(GetStockObject(LTGRAY_BRUSH));
 WndClass.lpszMenuName := nil;
 WndClass.lpszClassName := sClassName;
 if RegisterClass(WndClass) <> 0 then
   begin
    hWindow := CreateWindow(sClassName, 'Парсинг txt (WINAPI)',
                            WS_OVERLAPPEDWINDOW,
                            CW_USEDEFAULT,CW_USEDEFAULT,
                            640,480,
                            0,0,hInstance,nil);
    // Создаем текстовое поле для начальных данных
    Edit := CreateWindowEx( WS_EX_CLIENTEDGE, 'Edit', '',
     ES_AUTOHSCROLL or WS_CHILD or WS_VISIBLE or ES_MULTILINE,
     10, 10, 610, 200, hWindow, EditID, hInstance, nil );
    // загружаем текст из файла
    LoadFromFile;
    // Создаем кнопку
    Button := CreateWindow('button', 'Парсинг текста',
     WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON,
     10, 215, 610, 30, hWindow, ButtonID, hInstance, nil);
    // Создаем текстовое поле для результатов парсинга
    ResEdit := CreateWindowEx( WS_EX_CLIENTEDGE, 'Edit', '',
     ES_AUTOHSCROLL or WS_CHILD or WS_VISIBLE or ES_MULTILINE,
     10, 250, 610, 200, hWindow, ResEditID, hInstance, nil );
    if  hWindow <> 0 then
     begin
       ShowWindow(hWindow, CmdShow);
       UpdateWindow(hWindow);
       while GetMessage(msgMessage,0,0,0) do
        begin
         TranslateMessage(msgMessage);
         DispatchMessage(msgMessage);
        end;
       Halt(msgMessage.wParam);
     end else MessageBox(0,'Cannot create window','Error',MB_OK);
  end else MessageBox(0,'Cannot register class','Error',MB_OK);
end;

begin
 CreateParsWnd;
end.

[Stilet]

SetLength( Str, FS );

Эх препод придерется
Я бы придрался.

[VladWH]

Сообщение от Stilet

Эх препод придерется
Я бы придрался.

ну тогда так

Str: PCHAR; 
Len: Integer;
................
GetMem( Str, Len );
...........................
FreeMem( Str );

[Stilet]

ну тогда так

Тоже паскаль
А нужно Винапи !
Садись - два, завтра с родителями в школу

[VladWH]

Сообщение от Stilet

Тоже паскаль
А нужно Винапи !
Садись - два, завтра с родителями в школу

нужно ТС и преподавателю...

procedure LoadFromFile;
var FH: THandle;
FS,FHS: Cardinal;
Str: AnsiString;
begin
FH := CreateFile(PAnsiChar(GetModuleDirectory + '\q.txt'),
                 GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if FH=0 then
 begin
  MessageBox(hWindow, 'Îøèáêà ôàéëà!', '', 0);
  PostQuitMessage(0);
 end;
FS := GetFileSize(FH,@FHS);
Str := string(GetMemory(FS));
ReadFile(FH, Str[1], Length( Str ), FHS, nil);
SetWindowText( Edit, @Str[1] );
CloseHandle(FH);
FreeMemory(@str);
end;