SRL Archive - OSR Help

The purpose of this SCAR script was to dynamically generate comments that can be attached to the top of a SCAR script. But, somehow this script sometimes works, sometimes it doesn't. It compiles perfectly well, and even though it might seems so: THERE ARE NO INFINITE LOOPS.

I don't want a single person telling me "you have an infinite loop". That is NOT the case here. Proof is that I once ran this script and somehow I got 4 "Successfully Compiled" in a row in the debug window, even though I pressed play just once.

Immediately after pressing the button on the form in this script, the script either starts consuming 100% CPU, or it causes SCAR to freeze/crash.

Any suggestions/input? I seriously need help with this, else I'm going to port it to VB and create an application (not as elegant as a script :( ).

EDIT: Just a thought, is it possible that this script causes a buffer overrun in SCAR (the array + all the other crap are pretty memory intensive)?

Hmm I ran it as you said it completly hung… I cant see anything that would be causing it tho….

By the way since my duel core is so beastly it only took up 50% usage :D

Damn. SCAR is f*cking arround with me or wat???? I'll wait a few more posts till I go and port it to VB…

BTW: I'm jealous of your core duo :(. Meh, my laptop is 2 years old and I still haven't burned it's CPU out :D. Need to auto harder :D

I don't have alot of time to look, but what happend to me is, it compiled, gave me the form, and when I pressed "output", it said succesfully compiled.. (again)

Hope this helps.

often, i get this same error when i make my scripts, some how you must be working SCAR to hard…. it usally does it on my computer when i have to many
TTIMERs, im guessing it's all those STRING Functions….

This is really weird. Guess you're right, it must be all those string functions (buffer overrun, maybe the way strings are stored in memory or something). If SCAR can't handle it, VB does. I took the script and ported it to VB, works perfectly fine. Gonna go post it in VB section now :D.

instead of doing everything when the button is pressed, do it so that when the button is pressed the form closes down, and then everything is outputted. Also, put some waits into the script.

I like the part of the script that's not commented. It really helps in debugging. Good way to code. :p

Any way… The problem is definitely in CerterLine or Replace or both.

Fyi, instead of using the function Space() you can use Replicate(c:Char, i : integer); instead.

Ex.
Text := Replicate('*', 5); // Will return *****

program Commenter;

var
  frmMain    : TForm;
  GroupBox1  : TGroupBox;
  Label1     : TLabel;
  Label2     : TLabel;
  Label3     : TLabel;
  txtName    : TEdit;
  txtVersion : TEdit;
  txtAuthor  : TEdit;
  cmdOutput  : TButton;
  GroupBox2  : TGroupBox;
  GroupBox3  : TGroupBox;
  GroupBox4  : TGroupBox;
  mmoHowto   : TMemo;
  mmoAbout   : TMemo;
  mmoVersion : TMemo;
  TextArray  : array of string;

{******************************************************************************}
{                         Text-editing functions/procs                         }
{******************************************************************************}

function Replace(text : string; s1, s2 : string) : string;
var
  worktext : string;
  StringPointer : integer;
begin
  worktext := text;
  If pos(s1, worktext)>0 then
  begin
    repeat
      StringPointer := pos(s1, worktext);
      Result := copy(worktext, 0, StringPointer-1);
      Result := Result + s2;
      Result := Result + copy(worktext, (StringPointer + Length(s1)), Length(worktext));
      worktext := Result;
    until(pos(s1, worktext)=0);
  end else
    Result := text;
end;

//Creates 80 character separator
function SeparatorLine(spacer : char) : string;
var
  i : integer;
begin
  Result := '{';
  repeat
  Result := Result + spacer;
  i := i + 1;
  until(i = 78);
  Result := Result + '}';
end;

//Creates line with a centered title
function CenterLine(title : string; spacer : char; brackets : boolean) : string;
var
  front : integer;
begin
  front := (76/2) - (Length(title)/2)
  Result := '{' + Replicate(' ', front);
  Result := Replace(Result, ' ', spacer);
  if brackets = true then
    Result := Result + '[' + title + ']'
  else
    Result := Result + spacer + title + spacer;
  front := length(Result);
  //Result := Result + Replace(Replicate(' ', 79-front), ' ', Spacer);
end;

//Processes a line of text and generates correct lines
function ProcessLine(text : string; var OutputLength : integer) : string;
var
  StringPointer : Integer;
  worktext : string;
  FoundIt : boolean;
begin
  worktext := copy(text, 1, 78);
  StringPointer := Length(worktext) - 1;
  FoundIt := false;
  //Search for end of line
  repeat
    If pos(#13+#10, copy(worktext, StringPointer, 2))=1 then
    begin
      Result := copy(worktext, 0, StringPointer + 1);
      FoundIt := true;
    end else
      StringPointer := StringPointer - 1;
  until((StringPointer = 0)or(FoundIt=true));
  //Search for final space
  If FoundIt = false then
  begin
    StringPointer := Length(worktext) - 1;
    repeat
    If pos(' ', copy(worktext, StringPointer, 1))=1 then
    begin
      Result := copy(worktext, 0, StringPointer);
      FoundIt := true;
    end else
      StringPointer := StringPointer - 1;
    until((StringPointer = 0)or(FoundIt=true));
  end;
  OutputLength := Length(Result);
  Result := '{ ' + Result + Replicate(' ', 77 - Length(Result)) + '}';
  Result := Replace(Result, #13+#10, '  ');
end;

//Converts text into formatted array strings
function FixupText(text : string) : array of string;
var
  worktext : string;
  i, o : integer;
begin
  worktext := text + Replicate(' ', 2);
  i := 0;
  while(not(worktext='')) do
  begin
    setarraylength(Result, i + 1);
    Result[i] := ProcessLine(worktext, o);
    If length(worktext)>78 then
      delete(worktext, 1, o)
    else
      worktext := '';
    i := i + 1;
  end;
end;

{******************************************************************************}
{                            Arrays... Aw crap!                                }
{******************************************************************************}

procedure WriteArray(var arr : array of string);
var
  i : integer;
begin
  for i := 0 to getarraylength(arr) - 1 do
    Writeln(arr[i]);
end;

//Read a file relative to the script that handles it
function ReadFile(RelativePath : string) : string;
var
  FileNo : integer;
begin
  FileNo := OpenFile(ScriptPath + RelativePath, true);
  If FileNo > -1 then
  begin
    If not(ReadFileString(FileNo, Result, FileSize(FileNo))) then
      Result := 'error';
    CloseFile(FileNo);
  end else Result := 'error'
end;

{******************************************************************************}
{                         After the button is clicked...                       }
{******************************************************************************}

procedure cmdOutputClick(sender : TObject);
begin
  Writeln(CenterLine('Description and Release Notes', '=', true));
  //Writeln(CenterLine(txtName.Text + ' V ' + txtVersion.Text, ' ', false));
  Writeln(SeparatorLine('='));
  Writeln(SeparatorLine(' '));
  TextArray := FixupText(txtName.Text + ' ' + ReadFile('EULA.txt'));
  WriteArray(TextArray);
  Writeln(SeparatorLine(' '));
  //Writeln(CenterLine('About', '=', true));
  Writeln(SeparatorLine(' '));
  TextArray := FixupText(mmoAbout.Text);
  WriteArray(TextArray);
  Writeln(SeparatorLine(' '));
  //Writeln(CenterLine('How to use this', '=', true));
  Writeln(SeparatorLine(' '));
  TextArray := FixupText(mmoHowto.Text);
  WriteArray(TextArray);
  Writeln(SeparatorLine(' '));
  //Writeln(CenterLine('Version History', '=', true));
  Writeln(SeparatorLine(' '));
  TextArray := FixupText(mmoVersion.Text);
  WriteArray(TextArray);
  Writeln(SeparatorLine(' '));
  Writeln(SeparatorLine('='));
  //Writeln(CenterLine('Comments created with Botmaster''s commentor tool', '*', true));
end;

{******************************************************************************}
{                               All the form Stuff                             }
{******************************************************************************}

procedure UnsafeInitForm;
begin
  frmMain := CreateForm;
  frmMain.Left := 324;
  frmMain.Top := 39;
  frmMain.Width := 543;
  frmMain.Height := 596;
  frmMain.Caption := 'Botmaster - Commentator';
  frmMain.Color := clBtnFace;
  frmMain.Font.Color := clWindowText;
  frmMain.Font.Height := -11;
  frmMain.Font.Name := 'MS Sans Serif';
  frmMain.Font.Style := [];
  frmMain.Visible := False;
  frmMain.PixelsPerInch := 96;
  GroupBox1 := TGroupBox.Create(frmMain);
  GroupBox1.Parent := frmMain;
  GroupBox1.Left := 5;
  GroupBox1.Top := 3;
  GroupBox1.Width := 400;
  GroupBox1.Height := 75;
  GroupBox1.Caption := 'Script Details';
  GroupBox1.TabOrder := 0;
  Label1 := TLabel.Create(GroupBox1);
  Label1.Parent := GroupBox1;
  Label1.Left := 10;
  Label1.Top := 20;
  Label1.Width := 59;
  Label1.Height := 13;
  Label1.Caption := 'Script name:';
  Label2 := TLabel.Create(GroupBox1);
  Label2.Parent := GroupBox1;
  Label2.Left := 140;
  Label2.Top := 20;
  Label2.Width := 67;
  Label2.Height := 13;
  Label2.Caption := 'Script version:';
  Label3 := TLabel.Create(GroupBox1);
  Label3.Parent := GroupBox1;
  Label3.Left := 270;
  Label3.Top := 20;
  Label3.Width := 64;
  Label3.Height := 13;
  Label3.Caption := 'Autor'#39's name:';
  txtName := TEdit.Create(GroupBox1);
  txtName.Parent := GroupBox1;
  txtName.Left := 10;
  txtName.Top := 35;
  txtName.Width := 121;
  txtName.Height := 21;
  txtName.TabOrder := 0;
  txtVersion := TEdit.Create(GroupBox1);
  txtVersion.Parent := GroupBox1;
  txtVersion.Left := 140;
  txtVersion.Top := 35;
  txtVersion.Width := 121;
  txtVersion.Height := 21;
  txtVersion.TabOrder := 1;
  txtAuthor := TEdit.Create(GroupBox1);
  txtAuthor.Parent := GroupBox1;
  txtAuthor.Left := 269;
  txtAuthor.Top := 35;
  txtAuthor.Width := 121;
  txtAuthor.Height := 21;
  txtAuthor.TabOrder := 2;
  cmdOutput := TButton.Create(frmMain);
  cmdOutput.Parent := frmMain;
  cmdOutput.Left := 411;
  cmdOutput.Top := 10;
  cmdOutput.Width := 120;
  cmdOutput.Height := 65;
  cmdOutput.Caption := 'Output the comments!';
  cmdOutput.TabOrder := 1;
  cmdOutput.Onclick := @cmdOutputClick;
  GroupBox2 := TGroupBox.Create(frmMain);
  GroupBox2.Parent := frmMain;
  GroupBox2.Left := 5;
  GroupBox2.Top := 82;
  GroupBox2.Width := 525;
  GroupBox2.Height := 155;
  GroupBox2.Caption := 'About the script';
  GroupBox2.TabOrder := 2;
  mmoAbout := TMemo.Create(GroupBox2);
  mmoAbout.Parent := GroupBox2;
  mmoAbout.Left := 5;
  mmoAbout.Top := 15;
  mmoAbout.Width := 515;
  mmoAbout.Height := 135;
  mmoAbout.Lines.Add('Script idea, script developement, future versions, etc.');
  mmoAbout.ScrollBars := ssVertical;
  mmoAbout.TabOrder := 0;
  GroupBox3 := TGroupBox.Create(frmMain);
  GroupBox3.Parent := frmMain;
  GroupBox3.Left := 5;
  GroupBox3.Top := 240;
  GroupBox3.Width := 525;
  GroupBox3.Height := 156;
  GroupBox3.Caption := 'How to run the script';
  GroupBox3.TabOrder := 3;
  mmoHowto := TMemo.Create(GroupBox3);
  mmoHowto.Parent := GroupBox3;
  mmoHowto.Left := 5;
  mmoHowto.Top := 15;
  mmoHowto.Width := 515;
  mmoHowto.Height := 135;
  mmoHowto.ScrollBars := ssVertical;
  mmoHowto.TabOrder := 0;
  GroupBox4 := TGroupBox.Create(frmMain);
  GroupBox4.Parent := frmMain;
  GroupBox4.Left := 5;
  GroupBox4.Top := 400;
  GroupBox4.Width := 525;
  GroupBox4.Height := 156;
  GroupBox4.Caption := 'Version history';
  GroupBox4.TabOrder := 4;
  mmoVersion := TMemo.Create(GroupBox4);
  mmoVersion.Parent := GroupBox4;
  mmoVersion.Left := 5;
  mmoVersion.Top := 15;
  mmoVersion.Width := 515;
  mmoVersion.Height := 136;
  mmoVersion.ScrollBars := ssVertical;
  mmoVersion.TabOrder := 0;
  frmMain.ShowModal;
end;

procedure InitializeForm;
var
  v : TVariantArray;
begin
  setarraylength(v, 0);
  ThreadSafeCall('UnsafeInitForm', v);
end;

begin
  InitializeForm;
end.

~Ron :)

MMkay, will try it once I get on my home comp even though I already put it into VB (IMHO a lame language, but the only lingo I could get a "free" compiler for :p).

Thanks for all your help! BTW, I didn't know there was a replicate function in SCAR, ty for telling me.

EDIT: I used Replicate() and eliminated the space function. I also added wait(3) in all the loops. Now SCAR is giving me access violation prompts and still crashes, it just doesn't hang/consume 100% CPU anymore. Any suggestions?

EDIT #2: Fixed the access violations by making it close the form, but SCAR still hangs. WTF?

Put up your new script so we can see. :)

btw your Replace function was a ReplaceAll function right?

Well I recently perfected one today. Here you go if you like. :)

// The Replace() function will replace a string with another string.
// Made by Ron. :)
function Replace(TheString, Replacee, Replacer : String) : String;
var
  a: Integer;
begin
  Result := TheString;
  a := Pos(Replacee, Result);
  if (a > 0) then
  begin
    Delete(Result, a, Length(Replacee));
    Insert(Replacer, Result, a);
  end;
end;

// The ReplaceAll() function will replace all strings with another string.
// Made by Ron. :)
function ReplaceAll(Str, Replacee, Replacer : String) : String;
var
  n, t : Integer;
begin
  n := Pos(Replacee, Str);
  t := Length(Replacer) - 1;
  if(n > 0)then
  begin
    Result := '';
    while n > 0 do
    begin
      Str := Replace(Str, Replacee, Replacer);
      Result := Result + Copy(Str, 1, n + t);
      Delete(Str, 1, n + t);
      n := Pos(Replacee, Str);
    end;
    Result := Result + Str;
  end else
    Result := Str;
end;

~Ron

If it wasn't ReplaceAll your script would hang indefionitly. Try calling different funtions at different times if the above dosen't work.