Ultima Online Antares

Var
    _Path, _Str: String;
    _ID:          Cardinal;
    _TL:          TStringList;
    _I:          Integer;
    _Char_Types: array of Word;

Begin
    _Path:= 'путь, вида: D:\chars.txt';
    _Char_Types:= [$тип мужчины, $тип женщины];
    
    FindDistance:= 50;
    _TL:= TStringList.Create;
    If FileExists(_Path) Then _TL.LoadFromFile(_Path);
    While True Do Begin
        For _I:= 0 To 1 Do Begin
            If FindType(_Char_Types[_I], Ground) > 0 Then Begin
                _ID:= FindItem;
                _Str:= ('Name:= ' +GetName(_ID) + ' ID:=$' + IntToHex(_ID, 8));
                If _TL.IndexOf(_Str) = -1 Then _TL.Append(_Str);
            End;
        End;
        _TL.SaveToFile(_Path);
        Wait(100);
    End;
End.

{$Include 'WriteToFile.inc'}

var
counter : Integer;
Tmp,FileList : TStringList;
a : String;

Begin
    FileList := TStringList.Create();
    Tmp := TStringList.Create();
    FileList.LoadFromFile('Chars.log');
    For counter:=0 To (FileList.count-1) Do
    Begin
        StrBreakApart(FileList.Strings[counter], '    ', Tmp);
        Ignore(StrToInt(Tmp.Strings[0]));
    End;
    FileList.Free;
    Tmp.Free;

    Repeat
        FindDistance:=15;
        FindVertical:=50;
        If FindType($0190,$FFFFFFFF)>0 Then
        Begin
            ClickOnObject(FindItem);
            Wait(1000);
            a:=GetName(FindItem);
            If a<>'' Then Begin WriteToFile('Chars.log',IntToStr(FindItem)+Replicate('    ',1-(Length(IntToStr(FindItem))/8))+'    [M]    '+a+Replicate('    ',3-(Length(a)/8))+'    | ID: '+IntToHex(FindItem,8)+ #13#10); Ignore(FindItem); End;
        End;
        If FindType($0191,$FFFFFFFF)>0 Then
        Begin
            ClickOnObject(FindItem);
            Wait(1000);
            a:=GetName(FindItem);
            If a<>'' Then Begin WriteToFile('Chars.log',IntToStr(FindItem)+Replicate('    ',1-(Length(IntToStr(FindItem))/8))+'    [W]    '+a+Replicate('    ',3-(Length(a)/8))+'    | ID: '+IntToHex(FindItem,8)+ #13#10); Ignore(FindItem); End;
        End;
        Wait(333);
    Until False;
End .

procedure WriteToFile(filepath: string;   data: string);
var
  file: TFileStream;

begin
   try
     file := TFileStream.Create(filepath,fmOpenReadWrite);
     file.seek(0, soFromEnd);
        except
          file := TFileStream.Create(filepath,fmCreate);
        end;      
   file.WriteBuffer(data,Length(data));
   file.Free;
end;