www.pudn.com > MBASIC.zip > Unit1.pas

Unit Unit1; 
Interface 
Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 
Type 
	TForm1 = 
		Class(TForm) 
			Procedure FormCreate(Sender:TObject); 
		Private 
		Public 
		End; 
Var Form1:TForm1; 
Implementation 
{$R *.DFM} 
Procedure RunBasic(Source:TStringList); 
	Var 
		ConstNames,Consts	:TStringList; 
	Function ProcessCode:Boolean; 
		Var 
			Index,CNo,CNo2	:Integer; 
			S,S2			:String; 
		Label Rework; 
		Begin 
			Result := False; 
			CNo := 0; 
			For Index := 0 to Source.Count - 1 do Begin 
				// Start 
				S := Source[Index]; 
 
				// Remove comments 
				If Pos('''',S) > 0 then 
					S := Copy(S,1,Pos('''',S) - 1); 
 
				// Trim 
				S := Trim(S); 
 
				// String constants 
				Rework: 
				For CNo := 1 to Length(S) do Begin 
					If S[CNo] = '"' then Begin 
						CNo2 := CNo; 
						Repeat 
							Inc(CNo2); 
							If CNo2 > Length(S) then Begin 
								MessageBox(0,PChar('Line ' + IntToStr(Index) + ': String never ending error.'),PChar(Application.Title),16); 
								Exit; 
							End; 
						Until S[CNo2] = '"'; 
						S2 := 'instr_' + IntToHex(ConstNames.Count,8); 
						ConstNames.Add(S2); 
						Consts.Add(Copy(S,CNo + 1,CNo2 - CNo - 1)); 
						Delete(S,CNo,CNo2 - CNo + 1); 
						Insert(S2,S,CNo); 
						Goto Rework; 
					End; 
				End; 
 
				// Uppercase 
				S := AnsiUpperCase(S); 
				 
				// End 
				Source[Index] := S; 
			End; 
			Result := True; 
		End; 
	Begin 
		ConstNames := TStringList.Create; 
		Consts := TStringList.Create; 
		If ProcessCode then 
			; // Here we should run the project 
		Consts.SaveToFile('apa.consts.txt'); 
		ConstNames.Free; 
		Consts.Free; 
	End; 
Procedure TForm1.FormCreate(Sender: TObject); 
	Var Source:TStringList; 
	Begin 
		Source := TStringList.Create; 
		Source.LoadFromFile('apa.bas'); 
		RunBasic(Source); 
		Source.SaveToFile('apa.txt'); 
		Source.Free; 
		Halt; 
	End; 
End.