Appendfile and Return/enter

opiumhautopium1 · April 27, 2013

Hello i need a little help

i try to add links in a txt file

collect the links in scar is no problem

but now i will write a text file with

var
 f: Integer;
 s: string;

begin
 f := Rewritefile(LogsPath + 'Test.txt', False);
 WriteFileString(f, 'Hello World! ');
 CloseFile(f);

 f := Appendfile(LogsPath + 'Test.txt', False);
 WriteFileString(f, 'Hello Mars?');
 CloseFile(f);

 f := OpenFile(LogsPath + 'Test.txt', False);
 ReadFileString(f, s, FileSize(f));
 WriteLn(s);
 CloseFile(f);

 DeleteFile(LogsPath + 'Test.txt');
end.
Output:
Hello World! Hello Mars?

My problem is

I need Return/enter between the lines

like

Output:
Hello World!
Hello Mars?

is it possible?

greetings

Edited April 27, 2013 by opiumhautopium1

Janilabo · April 27, 2013

Yes, it is possible. You add there #13#10 which is new line.

var
 f: Integer;
 s: string;

begin
 f := Rewritefile(LogsPath + 'Test.txt', False);
 WriteFileString(f, 'Hello World! ' + #13#10);
 CloseFile(f);

 f := Appendfile(LogsPath + 'Test.txt', False);
 WriteFileString(f, 'Hello Mars?' + #13#10);
 CloseFile(f);

 f := OpenFile(LogsPath + 'Test.txt', False);
 ReadFileString(f, s, FileSize(f));
 WriteLn(s);
 CloseFile(f);

 DeleteFile(LogsPath + 'Test.txt');
end.

You may need to just tweak it a bit, in order to get it working just the way you need it to.

Right now, it also includes the empty line for debug, you can easily find ways to get rid of that.

- - - Updated - - -

Also, here is something you could have aswell.. For easier line adding:

// Adds new line to file by Path - adds #13#10 only if file isn't new/empty.
function AddFileLine(Path, str: string): Boolean;
var
 f: Integer;
 s: string;
begin    
 Result := False;
 try 
   if FileExists(Path) then
   begin
     f := OpenFile(Path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;    
   case (s <> '') of
     True: s := (s + #13#10 + str);
     False: s := (s + str);
   end; 
   f := RewriteFile(Path, False);
   try
     Result := WriteFileString(f, s);
   except
   finally
     CloseFile(f);
   end;  
 except 
   Result := False; 
 end; 
 s := '';
end;

var
 f: Integer;
 s, p: string;

begin
 p := (LogsPath + 'Test.txt');
 AddFileLine(p, 'Hello World!');
 AddFileLine(p, 'Hello Mars?');
 f := OpenFile(p, False);
 ReadFileString(f, s, FileSize(f));
 WriteLn(s);
 CloseFile(f);
 DeleteFile(p);
end.

That also makes sure it wont add any (extra) empty lines in.

- - - Updated - - -

I can also write you a function to read lines (return data with file line ID) from files.

opiumhautopium1 · April 27, 2013

great thank you very very mutch ^^

Janilabo · April 27, 2013

No problem buddy!

Do you want/need function for reading file lines? With file line ID. I can write you a function for that if you want?

-Jani

Janilabo · April 27, 2013

Hey opiumhautopium1,

Here is couple functions for counting file lines and also for reading data from file line:

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
function AddFileLine(path, str: string): Boolean;
var
 f: Integer;
 s: string;
begin    
 Result := False;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;    
   case (s <> '') of
     True: s := (s + #13#10 + str);
     False: s := (s + str);
   end; 
   f := RewriteFile(path, False);
   try
     Result := WriteFileString(f, s);
   except
   finally
     CloseFile(f);
   end;  
 except 
   Result := False; 
 end; 
 s := '';
end;

// Explodes str with multiple separators/delimiters (d).
// The importance order for d items is from left to right (=>).
// So place the important ones first and then less important after those.
function StrExplodeMulti(d: TStrArray; str: string): TStrArray;
var                          
 p, h, i, x, o, m, l: Integer;
begin
 h := High(d);
 if (h > -1) then
 begin 
   o := 1;
   SetLength(Result, Length(str));
   repeat  
     l := 0;           
     for x := 0 to h do
     begin
       p := Pos(d[x], str);
       case (p < 1) of
         True:
         begin
           Delete(d, x, 1);
           Dec(x);
           Dec(h);
         end;
         False:
         if ((l = 0) or (p < l)) then
         begin     
           m := x;
           l := p;
         end;
       end;
     end;
     if (l > 0) then            
     begin      
       Result[i] := Copy(str, 1, (l - 1));
       Delete(str, 1, ((l + Length(d[m])) - 1));         
       Inc(i);
     end else
       Result[i] := Copy(str, 1, Length(str));
   until (l = 0);
   SetLength(Result, (i + 1));
 end else
   Result := [string(str)];
end;

// Returns data from line index in the file by path.
function GetFileLine(path: string; line: Integer): string;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := '';
 try 
   if (FileExists(path) and (line > 0)) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     if (Length(t) >= line) then
       Result := string(t[(line - 1)]);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns count of lines in file by path.
function FileLineCount(path: string): Integer;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := 0;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     Result := Length(t);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

var
 i, t: Integer;
 p: string;

begin
 p := (LogsPath + 'Test.txt');
 AddFileLine(p, 'Hello World!');
 AddFileLine(p, 'Hello Mars?');   
 t := FileLineCount(p);
 for i := 1 to t do
   WriteLn('Line ' + IntToStr(i) + ': ' + GetFileLine(p, i));
 DeleteFile(p);
end.

Included small example.

-Jani

Edited April 27, 2013 by Janilabo

opiumhautopium1 · April 27, 2013

thx but i want to learn not copy ;-)

and my function to take the links work fine!

now i want to write the links in a TStrArray ((i dont know how)

and check for doubles with InStrArr

may be you can help me to create the TStrArray ?

if i want to put the links like

http://uploaded.net/file/1cemobm4/ska-gijoeret-xvid.part5.rar

http://uploaded.net/file/frncuy4e/ska-gijoeret-xvid.part7.rar

sometimes up to 500 links

greetings

Edited April 27, 2013 by opiumhautopium1

Janilabo · April 27, 2013

That's easy!

Here you go:

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
function AddFileLine(path, str: string): Boolean;
var
 f: Integer;
 s: string;
begin    
 Result := False;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;    
   case (s <> '') of
     True: s := (s + #13#10 + str);
     False: s := (s + str);
   end; 
   f := RewriteFile(path, False);
   try
     Result := WriteFileString(f, s);
   except
   finally
     CloseFile(f);
   end;  
 except 
   Result := False; 
 end; 
 s := '';
end;

// Explodes str with multiple separators/delimiters (d).
// The importance order for d items is from left to right (=>).
// So place the important ones first and then less important after those.
function StrExplodeMulti(d: TStrArray; str: string): TStrArray;
var                          
 p, h, i, x, o, m, l: Integer;
begin
 h := High(d);
 if (h > -1) then
 begin 
   o := 1;
   SetLength(Result, Length(str));
   repeat  
     l := 0;           
     for x := 0 to h do
     begin
       p := Pos(d[x], str);
       case (p < 1) of
         True:
         begin
           Delete(d, x, 1);
           Dec(x);
           Dec(h);
         end;
         False:
         if ((l = 0) or (p < l)) then
         begin     
           m := x;
           l := p;
         end;
       end;
     end;
     if (l > 0) then            
     begin      
       Result[i] := Copy(str, 1, (l - 1));
       Delete(str, 1, ((l + Length(d[m])) - 1));         
       Inc(i);
     end else
       Result[i] := Copy(str, 1, Length(str));
   until (l = 0);
   SetLength(Result, (i + 1));
 end else
   Result := [string(str)];
end;

// Returns data from line index in the file by path.
function GetFileLine(path: string; line: Integer): string;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := '';
 try 
   if (FileExists(path) and (line > 0)) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     if (Length(t) >= line) then
       Result := string(t[(line - 1)]);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns count of lines in file by path.
function FileLineCount(path: string): Integer;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := 0;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     Result := Length(t);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns ALL lines from the file by path as TStrArray.
function FileLines(path: string): TStrArray;
var
 f: Integer;
 s: string;
begin
 SetLength(Result, 0);
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     Result := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
   end;  
 except  
 end;
end;

var
 i, h: Integer;
 p: string; 
 t: TStrArray;

begin
 p := (LogsPath + 'Test.txt');
 AddFileLine(p, 'http://forums.scar-divi.com/forum.php');
 AddFileLine(p, 'http://wiki.scar-divi.com/SCAR_Divi_Online_Manual'); 
 AddFileLine(p, 'http://dev.scar-divi.com/');
 AddFileLine(p, 'http://www.scar-divi.com/');  
 t := FileLines(p);
 h := High(t);
 for i := 0 to h do
   WriteLn('t[' + IntToStr(i) + ']: "' + t[i] + '"'); 
 SetLength(t, 0);
 DeleteFile(p);
end.

Added in FileLines() function - that returns ALL the lines from file as TStrArray.

- - - Updated - - -

I am taking a look at your files, it will take me a moment to download another one of those, though. So be patient.

opiumhautopium1 · April 27, 2013

i upload/share a lot of stuff and sometimes takes a lot of time to get the right links from the linkkrypters see here [Action] Marvels The Avengers 3D 2012 MULTi COMPLETE BLURAY UNTOUCHED De Türk Eng - myGully.com

so now i will try the funktion thx 1000 times

Janilabo · April 27, 2013

Hold on mate, I am about to take a look at your file (downloading - 6 minutes left) for those links.

Anyways, I have also TSAUnique() function, that removes duplicates from TStrArray.

Just moment ago PasteBin'd this: [Pascal] Janilabo | TSAUnique() [sCAR Divi] - Pastebin.com

-Jani

- - - Updated - - -

Hey mate... I downloaded "ska-gijoeret-xvid.part7.rar" but sadly it says the file "ska-gijoeret-xvid.avi" is corrupted.

Also, I couldn't see any file with links inside it either...

Can you pastebin me the way those links are listed? The source you need to read for links and return as TStrArray? That would help a lot.

..unless you got the things going on already with those functions I posted here earlier.

opiumhautopium1 · April 27, 2013

i looked at TSAUnique...... looks good ... i will try it tommotw ..... wish you sweet dreams

i get the links like from this side http://linkcrypt.ws/dir/y90wa9154j788qs

my procedure capture the links by klick the right mouse button and save it to a txt file

but it is not good if klick 2 times at the same link.

thats the reason to chek the links

Edited April 27, 2013 by opiumhautopium1

Janilabo · April 27, 2013

i looked at TSAUnique...... looks good ... i will try it tommotw ..... wish you sweet dreams

Good night mate!

Sure hope I could help you out man. You can always ask for more help when/if you'll need it.

-Jani

opiumhautopium1 · April 28, 2013

your postings are great .... good to learn for me! like it!!

i wrote u something at last post

i remember the basics by read this post

{==============================================================================]   
 Explanation: Returns copy of TSA.                  
[==============================================================================}
function TSACopy(TSA: TStrArray): TStrArray;
var
 h, i: Integer;
begin
 h := High(TSA);
 SetLength(Result, (h + 1));
 for i := 0 to h do
   Result[i] := string(TSA[i]);
end;

var
 h, i: Integer;
 a, b: TStrArray;

begin
 ClearDebug;
 a := ['Test1', 'Test2', 'Test3', 'Test4'];
 b := TSACopy(a);
 SetLength(a, 0);
 h := High(b);
 for i := 0 to h do
   WriteLn(b[i]);
 SetLength(b, 0); 
end.

this syntax was my probem

 (TSA: TStrArray): TStrArray;
Result[i] := string(TSA[i]);

now i undestand to create it

thx again and wish u a suny day

Edited April 28, 2013 by opiumhautopium1

Janilabo · April 28, 2013

your postings are great .... good to learn for me! like it!!
i wrote u something at last post

Thanks mate!

Yeah, I checked out what you wrote there, but sadly I didn't really understand what I was looking for. The webpage just confused me..

I was merely after raw data as text, the data you are working around with using SCAR.

Do you have the links in a text file or so? If you do, PasteBin me an example, of the file with links.

-Jani

opiumhautopium1 · April 28, 2013

ill try it again

i will write a Linkgrabber

it shout take/extract the links from websides protected by linkcrypers

so i wrote this very very simple script

program Linkgrabber;
var c,f,g: Integer;
var a: String;




Procedure OpenTxTFile;
var
 b: String;
begin
 b:=(DateToStr(Date));
 f := Rewritefile(LogsPath + 'Linkliste.txt', False); 
 WriteFileString(f,b + #13#10 );
 CloseFile(f);  
 end;

Procedure WriteLinks;

Begin
 g := Appendfile(LogsPath + 'Linkliste.txt', False);
 WriteFileString(g, #13#10 + a  );
 CloseFile(g); 
end;

Procedure KlickCheck;
Begin

 if GetMouseBtnState(mbRight)= true then 
   begin  
     //WriteLn('Right mouse button is down!'); 
       If (GetCursorType)= (-21) Then 
         Begin  
          // WriteLn('HandMauszeiger gefunden');  
           ClearClipboard; 
           wait(200);
           PressKeyEx('e', 150); 
           wait(50);
           a:=(GetClipboard);  
           WriteLinks;
           WriteLn (a); 


       end;
   end; 
end;


begin
ClearDebug;
OpenTxTFile;
repeat
KlickCheck; 
until false;
end.

because if i want to grab 400 Links to Import with copy and paste is "JERKK"^^

this script works pretty good it has only one problem

if i Klick 2 Times in a link.... then i have a big problem

so (my Idea) i want to store the links in a array to check it with InStrArr

if InStrArr false ->> add this link to the attay ->> writelinks

Edited April 28, 2013 by opiumhautopium1

Janilabo · April 28, 2013

EDIT: Added some code for you - needs testing.

Ohhh, I can definitely help you out with that.

So, the script works for you, but you'll just need it to make sure you don't add items in it which already exist, correct?

I will be doing some tweaking for you.

- - - Updated - - -

Hey mate,

Does this work:

program Linkgrabber;

const
 FILE_NAME = 'Linkliste.txt';

var
 c, f, g: Integer; 

// Explodes str with multiple separators/delimiters (d).
// The importance order for d items is from left to right (=>).
// So place the important ones first and then less important after those.
function StrExplodeMulti(d: TStrArray; str: string): TStrArray;
var                          
 p, h, i, x, o, m, l: Integer;
begin
 h := High(d);
 if (h > -1) then
 begin 
   o := 1;
   SetLength(Result, Length(str));
   repeat  
     l := 0;           
     for x := 0 to h do
     begin
       p := Pos(d[x], str);
       case (p < 1) of
         True:
         begin
           Delete(d, x, 1);
           Dec(x);
           Dec(h);
         end;
         False:
         if ((l = 0) or (p < l)) then
         begin     
           m := x;
           l := p;
         end;
       end;
     end;
     if (l > 0) then            
     begin      
       Result[i] := Copy(str, 1, (l - 1));
       Delete(str, 1, ((l + Length(d[m])) - 1));         
       Inc(i);
     end else
       Result[i] := Copy(str, 1, Length(str));
   until (l = 0);
   SetLength(Result, (i + 1));
 end else
   Result := [string(str)];
end;

function TheTime: string;
var
 i: Integer;
 Hours, Minutes, Seconds, Milliseconds: Word;
 tTSA: array[0..3] of string;
 tmp: string;
begin
 DecodeTime(Now, Hours, Minutes, Seconds, Milliseconds);
 if (Hours > 23) then
   Hours := 0;
 tTSA[0] := IntToStr(Hours);
 tTSA[1] := IntToStr(Minutes);
 tTSA[2] := IntToStr(Seconds);
 tTSA[3] := IntToStr(Milliseconds);
 for i := 0 to 2 do
   if (StrToInt(tTSA[i]) < 10) then
   begin
     tmp := ('0' + string(tTSA[i]));
     tTSA[i] := string(tmp);
   end;
 while (Length(tTSA[3]) < 3) do
   tTSA[3] := (string(tTSA[3]) + '0');
 Result := string(tTSA[0] + ':' + tTSA[1] + ':' + tTSA[2] + '(:' + tTSA[3] + ')');
end;

{==============================================================================]   
 Explanation: Returns all positions of TSA which match with str.                 
[==============================================================================}
function TSAPosAll(TSA: TStrArray; str: string): TIntArray;
var
 i, r, h: Integer;
begin
 h := High(TSA);  
 if (h > -1) then
 begin
   SetLength(Result, (h + 1));
   for i := 0 to h do
     if (TSA[i] = str) then
     begin
       Result[r] := i;
       Inc(r);
     end; 
 end;
 SetLength(Result, r);
end;

procedure CreateTXTFile;
begin
 f := Rewritefile((LogsPath + FILE_NAME), False); 
 WriteFileString(f, (DateToStr(Date) + #13#10));
 CloseFile(f);  
end;

// Returns data from line index in the file by path.
function GetFileLine(path: string; line: Integer): string;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := '';
 try 
   if (FileExists(path) and (line > 0)) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     if (Length(t) >= line) then
       Result := string(t[(line - 1)]);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns count of lines in file by path.
function FileLineCount(path: string): Integer;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := 0;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     Result := Length(t);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns ALL lines from the file by path as TStrArray.
function FileLines(path: string): TStrArray;
var
 f: Integer;
 s: string;
begin
 SetLength(Result, 0);
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     Result := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
   end;  
 except  
 end;
end;

// Returns the count of str in file by path.
// Matches ONLY with full lines. SO, abcd <> abc whereas abcd = abcd!
function FileLineMatches(path, str: string): Integer;
var
 tmp: TStrArray;
begin
 tmp := FileLines(path);
 Result := Length(TSAPosAll(tmp, str));
 SetLength(tmp, 0);
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
// If uniqueOnly is set as true, this function will add str in file ONLY if str doesn't yet exist at any line of the file.
function AddFileLineEx(path, str: string; uniqueOnly: Boolean): Boolean;
var
 f: Integer;
 s: string; 
begin    
 Result := False;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;
   if (not uniqueOnly or (FileLineMatches(path, str) = 0)) then    
   case (s <> '') of
     True: s := (s + #13#10 + str);
     False: s := (s + str);
   end; 
   f := RewriteFile(path, False);
   try
     Result := WriteFileString(f, s);
   except
   finally
     CloseFile(f);
   end;  
 except 
   Result := False; 
 end; 
 s := '';
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
function AddFileLine(path, str: string): Boolean;
begin    
 Result := AddFileLineEx(path, str, False);
end;

procedure KlickCheck;
var
 a: string;
begin
 if GetMouseBtnState(mbRight) then 
 begin  
   //WriteLn('Right mouse button is down!'); 
   if (GetCursorType = -21) then 
   begin  
     //WriteLn('HandMauszeiger gefunden');  
     ClearClipboard; 
     Wait(200);
     PressKeyEx('e', 150); 
     Wait(50);    
     a := GetClipboard;
     case AddFileLineEx((LogsPath + FILE_NAME), a, True) of
       True: WriteLn(TheTime + ': Succesfully added "' + a + '"');
       False: WriteLn(TheTime + ': Failed to add "' + a + '" - line already exist..?');
     end; 
   end;
 end; 
end;

begin
 ClearDebug;
 CreateTXTFile;
 repeat
   KlickCheck;  
 until False;
end.

It should add only unique items in the file.

Edited April 28, 2013 by Janilabo

opiumhautopium1 · April 28, 2013

i can t grab a link ... the script executes and finih in one second .. normaly i shout stop it manuel when i finished to grab the links

Stopped execution (1795.1868 ms)
Successfully compiled (21.3042 ms)
Successfully executed (6.7794 ms)

Janilabo · April 28, 2013

Hmmm... It shouldn't do that. :\

Which SCAR version are you using?

- - - Updated - - -

What did you do before it stopped? Are you sure you didn't press SCAR Divi's stop hotkey?

Because, it should work just the way your old code worked (the mainloop, that is).

Did your old code work for you?

- - - Updated - - -

I am using SCAR Divi version 3.38.01 and I can't reproduce the behaviour you described up there..

Can you tell me the steps you did before it stopped?

Also, did you try running the script again? Perhaps even restart+retry running it might be good idea aswell.

Please try running this code below, is it problematic for you:

program Linkgrabber;

const
 FILE_NAME = 'Linkliste.txt';

var
 c, f, g: Integer; 

// Explodes str with multiple separators/delimiters (d).
// The importance order for d items is from left to right (=>).
// So place the important ones first and then less important after those.
function StrExplodeMulti(d: TStrArray; str: string): TStrArray;
var                          
 p, h, i, x, o, m, l: Integer;
begin
 h := High(d);
 if (h > -1) then
 begin 
   o := 1;
   SetLength(Result, Length(str));
   repeat  
     l := 0;           
     for x := 0 to h do
     begin
       p := Pos(d[x], str);
       case (p < 1) of
         True:
         begin
           Delete(d, x, 1);
           Dec(x);
           Dec(h);
         end;
         False:
         if ((l = 0) or (p < l)) then
         begin     
           m := x;
           l := p;
         end;
       end;
     end;
     if (l > 0) then            
     begin      
       Result[i] := Copy(str, 1, (l - 1));
       Delete(str, 1, ((l + Length(d[m])) - 1));         
       Inc(i);
     end else
       Result[i] := Copy(str, 1, Length(str));
   until (l = 0);
   SetLength(Result, (i + 1));
 end else
   Result := [string(str)];
end;

function TheTime: string;
var
 i: Integer;
 Hours, Minutes, Seconds, Milliseconds: Word;
 tTSA: array[0..3] of string;
 tmp: string;
begin
 DecodeTime(Now, Hours, Minutes, Seconds, Milliseconds);
 if (Hours > 23) then
   Hours := 0;
 tTSA[0] := IntToStr(Hours);
 tTSA[1] := IntToStr(Minutes);
 tTSA[2] := IntToStr(Seconds);
 tTSA[3] := IntToStr(Milliseconds);
 for i := 0 to 2 do
   if (StrToInt(tTSA[i]) < 10) then
   begin
     tmp := ('0' + string(tTSA[i]));
     tTSA[i] := string(tmp);
   end;
 while (Length(tTSA[3]) < 3) do
   tTSA[3] := (string(tTSA[3]) + '0');
 Result := string(tTSA[0] + ':' + tTSA[1] + ':' + tTSA[2] + '(:' + tTSA[3] + ')');
end;

{==============================================================================]   
 Explanation: Returns all positions of TSA which match with str.                 
[==============================================================================}
function TSAPosAll(TSA: TStrArray; str: string): TIntArray;
var
 i, r, h: Integer;
begin
 h := High(TSA);  
 if (h > -1) then
 begin
   SetLength(Result, (h + 1));
   for i := 0 to h do
     if (TSA[i] = str) then
     begin
       Result[r] := i;
       Inc(r);
     end; 
 end;
 SetLength(Result, r);
end;

procedure CreateTXTFile;
begin
 f := Rewritefile((LogsPath + FILE_NAME), False); 
 WriteFileString(f, (DateToStr(Date) + #13#10));
 CloseFile(f);  
end;

// Returns data from line index in the file by path.
function GetFileLine(path: string; line: Integer): string;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := '';
 try 
   if (FileExists(path) and (line > 0)) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     if (Length(t) >= line) then
       Result := string(t[(line - 1)]);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns count of lines in file by path.
function FileLineCount(path: string): Integer;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := 0;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     Result := Length(t);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns ALL lines from the file by path as TStrArray.
function FileLines(path: string): TStrArray;
var
 f: Integer;
 s: string;
begin
 SetLength(Result, 0);
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     Result := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
   end;  
 except  
 end;
end;

// Returns the count of str in file by path.
// Matches ONLY with full lines. SO, abcd <> abc whereas abcd = abcd!
function FileLineMatches(path, str: string): Integer;
var
 tmp: TStrArray;
begin
 tmp := FileLines(path);
 Result := Length(TSAPosAll(tmp, str));
 SetLength(tmp, 0);
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
// If uniqueOnly is set as true, this function will add str in file ONLY if str doesn't yet exist at any line of the file.
function AddFileLineEx(path, str: string; uniqueOnly: Boolean): Boolean;
var
 f: Integer;
 s: string; 
begin    
 Result := False;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;
   if (not uniqueOnly or (FileLineMatches(path, str) = 0)) then    
   case (s <> '') of
     True: s := (s + #13#10 + str);
     False: s := (s + str);
   end; 
   f := RewriteFile(path, False);
   try
     Result := WriteFileString(f, s);
   except
   finally
     CloseFile(f);
   end;  
 except 
   Result := False; 
 end; 
 s := '';
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
function AddFileLine(path, str: string): Boolean;
begin    
 Result := AddFileLineEx(path, str, False);
end;

procedure KlickCheck;
var
 a: string;
begin
 if GetMouseBtnState(mbRight) then 
 begin  
   //WriteLn('Right mouse button is down!'); 
   if (GetCursorType = -21) then 
   begin  
     //WriteLn('HandMauszeiger gefunden');  
     ClearClipboard; 
     Wait(200);
     PressKeyEx('e', 150); 
     Wait(50);    
     a := GetClipboard;
     case AddFileLineEx((LogsPath + FILE_NAME), a, True) of
       True: WriteLn(TheTime + ': Succesfully added "' + a + '"');
       False: WriteLn(TheTime + ': Failed to add "' + a + '" - line already exist..?');
     end; 
   end;
 end; 
end;

begin
 ClearDebug;
 CreateTXTFile;
 repeat
   KlickCheck;  
 until False;
end.

Do you get the same problem with that?

Edited April 28, 2013 by Janilabo

opiumhautopium1 · April 28, 2013

It works !!!!!!!!! *jihaaaaa* u are great ..... and yous script is better than myone so i will use your script !!! thanks a lot !!!!

meanwile i solf the problem at this way (of course it is a noob skript but it works)

may be u are interested at my way

program Linkgrabber;
var c,f,g: Integer;
var a: String;
var AllLilnks: TStringArray;

Function UniQecheck:Boolean;

begin
Result:= False;
if  InStrArr(a, AllLilnks, True) then Result:= true;
end;

Procedure OpenTxTFile;
var
 b: String;
begin
 b:=(DateToStr(Date));
 f := Rewritefile(LogsPath + 'Linkliste.txt', False); 
 WriteFileString(f,b + #13#10 );
 CloseFile(f);  
 end;

Procedure WriteLinks;

Begin
 g := Appendfile(LogsPath + 'Linkliste.txt', False);
 WriteFileString(g, #13#10 + a  );
 CloseFile(g); 
end;

Procedure KlickCheck;
Begin

 if GetMouseBtnState(mbRight)= true then 
   begin  
     //WriteLn('Right mouse button is down!'); 
       If (GetCursorType)= (-21) Then 
         Begin  
          // WriteLn('HandMauszeiger gefunden');  
           ClearClipboard; 
           wait(200);
           PressKeyEx('e', 150); 
           wait(50);
           a:=(GetClipboard);  
           WriteLn (a); 
           If UniQecheck = False then 
           Begin
           WriteLinks;
           AllLilnks[c]:=a;  
           //WriteLn(Implode(' ', AllLilnks));
           Inc(c);
           //WriteLn (c);  
           end;
       end;
   end; 
end;


begin
SetLength(AllLilnks,500); 
ClearDebug;
c:=0;
OpenTxTFile;
repeat
KlickCheck; 
until false;
end.

so the weekend can begin *lol* ........... have a nice time and thanks for the script ^^

Janilabo · April 28, 2013

EDIT: Did some logical tweaking to the script!

Glad to hear you got it working buddy!

Sweet solution man!

I must say, I totally forgot about SCAR Divi's InStrArr().

- - - Updated - - -

Hey mate, I tweaked the code just a bit with InStrArr() - added a little more speed with it.

Also, added small logical tweak for AddFileLineEx().

Here you go:

program Linkgrabber;

const
 FILE_NAME = 'Linkliste.txt';

var
 c, f, g: Integer; 

// Explodes str with multiple separators/delimiters (d).
// The importance order for d items is from left to right (=>).
// So place the important ones first and then less important after those.
function StrExplodeMulti(d: TStrArray; str: string): TStrArray;
var                          
 p, h, i, x, o, m, l: Integer;
begin
 h := High(d);
 if (h > -1) then
 begin 
   o := 1;
   SetLength(Result, Length(str));
   repeat  
     l := 0;           
     for x := 0 to h do
     begin
       p := Pos(d[x], str);
       case (p < 1) of
         True:
         begin
           Delete(d, x, 1);
           Dec(x);
           Dec(h);
         end;
         False:
         if ((l = 0) or (p < l)) then
         begin     
           m := x;
           l := p;
         end;
       end;
     end;
     if (l > 0) then            
     begin      
       Result[i] := Copy(str, 1, (l - 1));
       Delete(str, 1, ((l + Length(d[m])) - 1));         
       Inc(i);
     end else
       Result[i] := Copy(str, 1, Length(str));
   until (l = 0);
   SetLength(Result, (i + 1));
 end else
   Result := [string(str)];
end;

function TheTime: string;
var
 i: Integer;
 Hours, Minutes, Seconds, Milliseconds: Word;
 tTSA: array[0..3] of string;
 tmp: string;
begin
 DecodeTime(Now, Hours, Minutes, Seconds, Milliseconds);
 if (Hours > 23) then
   Hours := 0;
 tTSA[0] := IntToStr(Hours);
 tTSA[1] := IntToStr(Minutes);
 tTSA[2] := IntToStr(Seconds);
 tTSA[3] := IntToStr(Milliseconds);
 for i := 0 to 2 do
   if (StrToInt(tTSA[i]) < 10) then
   begin
     tmp := ('0' + string(tTSA[i]));
     tTSA[i] := string(tmp);
   end;
 while (Length(tTSA[3]) < 3) do
   tTSA[3] := (string(tTSA[3]) + '0');
 Result := string(tTSA[0] + ':' + tTSA[1] + ':' + tTSA[2] + '(:' + tTSA[3] + ')');
end;

{==============================================================================]   
 Explanation: Returns all positions of TSA which match with str.                 
[==============================================================================}
function TSAPosAll(TSA: TStrArray; str: string): TIntArray;
var
 i, r, h: Integer;
begin
 h := High(TSA);  
 if (h > -1) then
 begin
   SetLength(Result, (h + 1));
   for i := 0 to h do
     if (TSA[i] = str) then
     begin
       Result[r] := i;
       Inc(r);
     end; 
 end;
 SetLength(Result, r);
end;

procedure CreateTXTFile;
begin
 f := Rewritefile((LogsPath + FILE_NAME), False); 
 WriteFileString(f, (DateToStr(Date) + #13#10));
 CloseFile(f);  
end;

// Returns data from line index in the file by path.
function GetFileLine(path: string; line: Integer): string;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := '';
 try 
   if (FileExists(path) and (line > 0)) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     if (Length(t) >= line) then
       Result := string(t[(line - 1)]);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns count of lines in file by path.
function FileLineCount(path: string): Integer;
var
 f: Integer;
 s: string;
 t: TStrArray;
begin
 Result := 0;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     t := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
     Result := Length(t);
     SetLength(t, 0);
   end;  
 except  
 end;
end;

// Returns ALL lines from the file by path as TStrArray.
function FileLines(path: string): TStrArray;
var
 f: Integer;
 s: string;
begin
 SetLength(Result, 0);
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
     Result := StrExplodeMulti([#13#10, #13, #10], s);
     s := '';
   end;  
 except  
 end;
end;

// Returns the count of str in file by path.
// Matches ONLY with full lines. SO, abcd <> abc whereas abcd = abcd!
function FileLineMatches(path, str: string): Integer;
var
 tmp: TStrArray;
begin
 tmp := FileLines(path);
 Result := Length(TSAPosAll(tmp, str));
 SetLength(tmp, 0);
end;

// Returns true if str already exist at some line in file by path. CASE-SENSITIVE!
function FileLineExists(path, str: string): Boolean;
var
 tmp: TStrArray;
begin
 tmp := FileLines(path);     
 Result := InStrArr(str, tmp, True); 
 SetLength(tmp, 0);
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
// If uniqueOnly is set as true, this function will add str in file ONLY if str doesn't yet exist at any line of the file.
function AddFileLineEx(path, str: string; uniqueOnly: Boolean): Boolean;
var
 f: Integer;
 s: string; 
begin    
 Result := False;
 try 
   if FileExists(path) then
   begin
     f := OpenFile(path, False);
     try
       ReadFileString(f, s, FileSize(f)); 
     except       
     finally
       CloseFile(f);
     end;
   end;
   if (not uniqueOnly or not FileLineExists(path, str)) then
   begin    
     case (s <> '') of
       True: s := (s + #13#10 + str);
       False: s := (s + str);
     end; 
     f := RewriteFile(path, False);
     try
       Result := WriteFileString(f, s);
     except
     finally
       CloseFile(f);
     end;  
   end;
 except 
   Result := False; 
 end; 
 s := '';
end;

// Adds new line to file by path - adds #13#10 only if file isn't new/empty.
function AddFileLine(path, str: string): Boolean;
begin    
 Result := AddFileLineEx(path, str, False);
end;

procedure KlickCheck;
var
 a: string;
begin
 if GetMouseBtnState(mbRight) then 
 begin  
   //WriteLn('Right mouse button is down!'); 
   if (GetCursorType = -21) then 
   begin  
     //WriteLn('HandMauszeiger gefunden');  
     ClearClipboard; 
     Wait(200);
     PressKeyEx('e', 150); 
     Wait(50);    
     a := GetClipboard;
     case AddFileLineEx((LogsPath + FILE_NAME), a, True) of
       True: WriteLn(TheTime + ': Succesfully added "' + a + '"');
       False: WriteLn(TheTime + ': Failed to add "' + a + '" - line already exist..?');
     end; 
   end;
 end; 
end;

begin
 ClearDebug;
 CreateTXTFile;
 repeat
   KlickCheck;  
 until False;
end.

Here is your way without limit to 500 links:

program Linkgrabber;

var
 f, g: Integer;
 a: string;
 AllLinks: TStrArray;

{==============================================================================]   
 Explanation: Appends TSA with x.                   
[==============================================================================}
procedure TSAAppend(var TSA: TStrArray; x: string);
var
 aL: Integer;
begin
 aL := (Length(TSA) + 1);
 SetLength(TSA, aL);
 TSA[(aL - 1)] := string(x);
end;

procedure OpenTXTFile;
var
 b: string;
begin
 f := Rewritefile((LogsPath + 'Linkliste.txt'), False); 
 WriteFileString(f, (DateToStr(Date) + #13#10));
 CloseFile(f);  
end;

procedure WriteLinks;
begin
 g := Appendfile((LogsPath + 'Linkliste.txt'), False);
 WriteFileString(g, (#13#10 + a));
 CloseFile(g); 
end;

procedure KlickCheck;
begin
 if GetMouseBtnState(mbRight) then 
 begin  
   //WriteLn('Right mouse button is down!'); 
   if (GetCursorType = -21) Then 
   begin  
     //WriteLn('HandMauszeiger gefunden');  
     ClearClipboard; 
     Wait(200);
     PressKeyEx('e', 150); 
     Wait(50);
     a := GetClipboard;  
     WriteLn(a); 
     if not InStrArr(a, AllLinks, True) then 
     begin
       WriteLinks;   
       TSAAppend(AllLinks, a);
       //WriteLn(Implode(' ', AllLinks));
       //WriteLn(l);  
     end;
   end;
 end; 
end;

begin
 ClearDebug;
 OpenTXTFile;
 repeat
   KlickCheck; 
 until False;
end.

Enjoy!

Edited April 28, 2013 by Janilabo

Sign In

Appendfile and Return/enter

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation