home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORGE20.ZIP / EXTPROC4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  3.7 KB  |  150 lines
  1. Procedure Strip_Spaces;
  2.  
  3. {strips spaces from beginning and end of TempVar}
  4. Begin
  5.   If Length(TempVar) <> 0 Then
  6.     While Copy(TempVar,1,1) = Chr(32) Do Delete(TempVar,1,1);
  7.   If Length(TempVar) <> 0 Then Begin
  8.     i:= Length(TempVar);
  9.     While Copy(TempVar,i,1) = Chr(32) Do Begin
  10.       Delete(TempVar,i,1);
  11.       i:= i-1;
  12.       End;
  13.     End;
  14. End; { procedure strip_spaces }
  15.  
  16.  
  17.  
  18.  
  19. Procedure Gather_Input_Info;
  20.  
  21. Var
  22.   LOF:  Integer;   { Length Of Field }
  23.  
  24. Begin
  25.   Tab;
  26.   LOF:= ((MaxY-1)*80+MaxX)-((MinY-1)*80+MinX)+1;
  27.   TempVar:= '';
  28.   For i:= 1 to LOF Do Begin
  29.     TempVar:= TempVar + ScrBuf[XY];
  30.     XY:= XY+1;
  31.     End;
  32. End;
  33.  
  34.  
  35. Procedure Find_Error;
  36.  
  37. Begin
  38.     GotoXY(2,25);
  39.     TextBackground(LightGray);
  40.     TextColor(Black);
  41.     For i:= 1 to 65 Do Write(Chr(32));
  42.     GotoXY(12,25);
  43.     Write('Field must contain only number characters,.,-');
  44.     Entry_Field:= Entry_Field - 1;
  45.     Tab;
  46.     While (not X > ErrorPos) Do
  47.       Rt1;
  48.     Done_Reading_Kbd:= False;
  49.     Repeat
  50.       ReadKbd;
  51.     Until Done_Reading_Kbd;
  52.     Entry_Field:= Entry_Field-1;
  53. End;
  54.  
  55.  
  56.  
  57.  
  58.  
  59. Procedure Check_For_BadName(Name: Str12);
  60.  
  61. Var
  62.   ch: Char;    { this is what we're going to check to make sure it's valid }
  63.   Name_Len: Integer;  { length of the file name to be checked }
  64.   Str1: String[1];
  65.   x: Integer;   { position within the name }
  66.  
  67. Begin
  68.   Str1:= Copy(Name,1,1);
  69.   ch:= Str1;
  70.   Name_Len:= Length(Name);
  71.   x:= 1;
  72.     While Not (x > Name_Len) Do Begin
  73.       Str1:= Copy(Name,x,1);
  74.       ch:= Str1;
  75.       Good_Char:= (ch in ['a'..'z','A'..'Z','0'..'9','_','.','$','&',
  76.                           '#','@','!','%','(',')','-','{','}','/','\']);
  77.       If Not Good_Char Then Begin
  78.           Sound(1000);
  79.           Delay(100);
  80.           NoSound;
  81.           GotoXY(1,25);
  82.           TextColor(Black);
  83.           TextBackground(White);
  84.           For x:= 1 to 78 Do
  85.             Write(' ');
  86.           GotoXY(4,25);
  87.           Write('File name has an invalid character in it.');
  88.           TextColor(Yellow);
  89.           TextBackground(Black);
  90.           x:= Name_Len;  { no need to go any further }
  91.           BadName:= True;
  92.           x:= x+1;
  93.           End { if not Good_Char }
  94.       Else Begin { it is a good char }
  95.         If ((ch = '.') and (Name_Len - x > 3)) Then Begin
  96.           Sound(1000);
  97.           Delay(100);
  98.           NoSound;
  99.           GotoXY(1,25);
  100.           TextColor(Black);
  101.           TextBackground(White);
  102.           For x:= 1 to 78 Do
  103.             Write(' ');
  104.           GotoXY(15,25);
  105.           Write('File name ext may have no more that 3 characters.');
  106.           TextColor(Yellow);
  107.           TextBackground(Black);
  108.           x:= Name_Len;  { no need to go any further }
  109.           BadName:= True;
  110.           End { If ((ch = '.') and (Name_Len - x > 3)) }
  111.         Else
  112.         x:= x+1; { let's look at the next one }
  113.         End; { else it is a good char }
  114.       End; { While Not (x > Name_Len) }
  115. End; { Procedure Check_For_BadName }
  116.  
  117.  
  118. Procedure Open_File;
  119.  
  120. Begin
  121.  
  122.   GotoXY(25,12);
  123.   Write('Data File Name');
  124.   Repeat
  125.     TextColor(LightRed);
  126.     GotoXY(30,13);
  127.     Readln(File_Name);
  128.     BadName:= False;
  129.     Check_For_BadName(File_Name);
  130.   Until Not BadName;
  131.   TextColor(Yellow);
  132.   Assign (Output_File, File_Name);
  133.   {$I-} Reset(Output_File) {$I+};   {turn off I/O error checking}
  134.   EXISTS:= (IOresult = 0);         {file does exist }
  135.   If Not EXISTS Then Begin         {file does not exist}
  136.     Rewrite(Output_File);
  137.     Current_File_Pos:= FilePos(Output_File)+1;
  138.     ClrScr;
  139.     End
  140.   Else         {IOresult = 0, therefore it is an existing file}
  141.    Begin
  142.     ClrScr;
  143.     Seek(Output_File, FileSize(Output_File));
  144.     Current_File_Pos:= FilePos(Output_File)+1;
  145.    End;
  146.  
  147. End; { procedure open_file }
  148.  
  149.  
  150.