paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 11:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Moved to correct locations

Browse Source
This commit is contained in:
michael 2004-10-22 21:55:45 +00:00
parent 791bbf520e
commit 7462988104
79 changed files with 0 additions and 1786 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
docs/linuxex/ex1.pp
View File

@ -1,10 +0,0 @@
Program Example1;
{ Program to demonstrate the GetEpochTime function. }
Uses Unix;
begin
Write ('Secs past the start of the Epoch (00:00 1/1/1980) : ');
Writeln (GetEpochTime);
end.

11
docs/linuxex/ex10.pp
View File

@ -1,11 +0,0 @@
Program Example10;
{ Program to demonstrate the Execl function. }
Uses unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is NOT looked for in PATH environment variable.}
Execl ('/bin/ls -l');
end.

12
docs/linuxex/ex11.pp
View File

@ -1,12 +0,0 @@
Program Example11;
{ Program to demonstrate the Execle function. }
Uses Unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is NOT looked for in PATH environment variable.}
{ envp is defined in the system unit.}
Execle ('/bin/ls -l',envp);
end.

12
docs/linuxex/ex12.pp
View File

@ -1,12 +0,0 @@
Program Example12;
{ Program to demonstrate the Execlp function. }
Uses Unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is looked for in PATH environment variable.}
{ envp is defined in the system unit.}
Execlp ('ls -l',envp);
end.

11
docs/linuxex/ex13.pp
View File

@ -1,11 +0,0 @@
Program Example13;
{ Program to demonstrate the Shell function. }
Uses Unix;
begin
{ This will send the output of 'ls -l' to the file ls.out }
{ thanks to the shell's redirection functionality }
Shell ('ls -l >ls.out')
end.

24
docs/linuxex/ex14.pp
View File

@ -1,24 +0,0 @@
Program Example14;
{ Program to demonstrate the Fork and WaitPidfunction. }
Uses BaseUnix;
Var PID, ExitStatus : cint;
begin
Writeln ('Spawning a child');
PID:=fpFork;
If PID=0 then
begin
Writeln ('Hello From the Child !!');
Writeln ('Exiting with exit status 1 !');
Halt (1);
end
Else
begin
Writeln ('Spawned child with PID : ',PID);
fpWaitPid (PID,@ExitStatus,0);
Writeln ('Child exited with status : ',ExitStatus shr 8);
end;
end.

14
docs/linuxex/ex15.pp
View File

@ -1,14 +0,0 @@
Program Example15;
{ Program to demonstrate the Nice and Get/SetPriority functions. }
Uses BaseUnix,Unix;
begin
writeln ('Setting priority to 5');
fpsetpriority (prio_process,fpgetpid,5);
writeln ('New priority = ',fpgetpriority (prio_process,fpgetpid));
writeln ('Doing nice 10');
fpnice (10);
writeln ('New Priority = ',fpgetpriority (prio_process,fpgetpid));
end.

9
docs/linuxex/ex16.pp
View File

@ -1,9 +0,0 @@
Program Example16;
{ Program to demonstrate the GetPid, GetPPid function. }
Uses BaseUnix;
begin
Writeln ('Process Id = ',fpgetpid,' Parent process Id = ',fpgetppid);
end.

9
docs/linuxex/ex17.pp
View File

@ -1,9 +0,0 @@
Program Example17;
{ Program to demonstrate the GetUid and GetEUid functions. }
Uses BaseUnix;
begin
writeln ('User Id = ',fpgetuid,' Effective user Id = ',fpgeteuid);
end.

9
docs/linuxex/ex18.pp
View File

@ -1,9 +0,0 @@
Program Example18;
{ Program to demonstrate the GetGid and GetEGid functions. }
Uses BaseUnix;
begin
writeln ('Group Id = ',fpgetgid,' Effective group Id = ',fpgetegid);
end.

19
docs/linuxex/ex19.pp
View File

@ -1,19 +0,0 @@
Program Example19;
{ Program to demonstrate the fdOpen, fdwrite and fdCLose functions. }
Uses BaseUnix;
Const Line : String[80] = 'This is easy writing !';
Var FD : Cint;
begin
FD:=fpOpen ('Test.dat',O_WrOnly or O_Creat);
if FD>0 then
begin
if length(Line)<>fpwrite (FD,Line[1],Length(Line)) then
Writeln ('Error when writing to file !');
fpClose(FD);
end;
end.

17
docs/linuxex/ex2.pp
View File

@ -1,17 +0,0 @@
Program Example2;
{ Program to demonstrate the GetTimeOfDay function. }
Uses BaseUnix,Unix;
Var TV : TimeVal;
TZ : TimeZone;
begin
fpGetTimeOfDay (@TV,@tz);
Writeln ('Seconds : ',tv.tv_sec);
Writeln ('Milliseconds : ',tv.tv_usec);
Writeln ('Minutes west of GMT : ',tz.minuteswest);
Writeln ('Daylight Saving Time : ',tz.dsttime);
Writeln ('Seconds in 1 call : ',fpGetTimeOfDay(nil,nil));
end.

46
docs/linuxex/ex20.pp
View File

@ -1,46 +0,0 @@
Program Example20;
{ Program to demonstrate the fdRead and fdTruncate functions. }
Uses BaseUnix;
Const Data : string[10] = '1234567890';
Var FD : cint;
l : longint;
begin
FD:=fpOpen('test.dat',o_wronly or o_creat,&666);
if fd>0 then
begin
{ Fill file with data }
for l:=1 to 10 do
if fpWrite (FD,Data[1],10)<>10 then
begin
writeln ('Error when writing !');
halt(1);
end;
fpClose(FD);
FD:=fpOpen('test.dat',o_rdonly);
{ Read data again }
If FD>0 then
begin
For l:=1 to 5 do
if fpRead (FD,Data[1],10)<>10 then
begin
Writeln ('Error when Reading !');
Halt(2);
end;
fpClose(FD);
{ Truncating file at 60 bytes }
{ For truncating, file must be open or write }
FD:=fpOpen('test.dat',o_wronly,&666);
if FD>0 then
begin
if fpfTruncate(FD,60)<>0 then
Writeln('Error when truncating !');
fpClose (FD);
end;
end;
end;
end.

31
docs/linuxex/ex21.pp
View File

@ -1,31 +0,0 @@
Program Example21;
{ Program to demonstrate the Link and UnLink functions. }
Uses BaseUnix;
Var F : Text;
S : String;
begin
Assign (F,'test.txt');
Rewrite (F);
Writeln (F,'This is written to test.txt');
Close(f);
{ new.txt and test.txt are now the same file }
if fpLink ('test.txt','new.txt')<>0 then
writeln ('Error when linking !');
{ Removing test.txt still leaves new.txt }
If fpUnlink ('test.txt')<>0 then
Writeln ('Error when unlinking !');
Assign (f,'new.txt');
Reset (F);
While not EOF(f) do
begin
Readln(F,S);
Writeln ('> ',s);
end;
Close (f);
{ Remove new.txt also }
If not FPUnlink ('new.txt')<>0 then
Writeln ('Error when unlinking !');
end.

33
docs/linuxex/ex22.pp
View File

@ -1,33 +0,0 @@
Program Example22;
{ Program to demonstrate the SymLink and UnLink functions. }
Uses baseunix,Unix;
Var F : Text;
S : String;
begin
Assign (F,'test.txt');
Rewrite (F);
Writeln (F,'This is written to test.txt');
Close(f);
{ new.txt and test.txt are now the same file }
if fpSymLink ('test.txt','new.txt')<>0 then
writeln ('Error when symlinking !');
{ Removing test.txt still leaves new.txt
Pointing now to a non-existent file ! }
If fpUnlink ('test.txt')<>0 then
Writeln ('Error when unlinking !');
Assign (f,'new.txt');
{ This should fail, since the symbolic link
points to a non-existent file! }
{$i-}
Reset (F);
{$i+}
If IOResult=0 then
Writeln ('This shouldn''t happen');
{ Now remove new.txt also }
If fpUnlink ('new.txt')<>0 then
Writeln ('Error when unlinking !');
end.

19
docs/linuxex/ex23.pp
View File

@ -1,19 +0,0 @@
Program Example23;
{ Program to demonstrate the Chmod function. }
Uses BaseUnix,Unix;
Var F : Text;
begin
{ Create a file }
Assign (f,'testex21');
Rewrite (F);
Writeln (f,'#!/bin/sh');
Writeln (f,'echo Some text for this file');
Close (F);
fpChmod ('testex21',&777);
{ File is now executable }
execl ('./testex21');
end.

29
docs/linuxex/ex24.pp
View File

@ -1,29 +0,0 @@
Program Example24;
{ Program to demonstrate the Chown function. }
Uses BaseUnix;
Var UID : TUid;
GID : TGid;
F : Text;
begin
Writeln ('This will only work if you are root.');
Write ('Enter a UID : ');readln(UID);
Write ('Enter a GID : ');readln(GID);
Assign (f,'test.txt');
Rewrite (f);
Writeln (f,'The owner of this file should become : ');
Writeln (f,'UID : ',UID);
Writeln (f,'GID : ',GID);
Close (F);
if fpChown ('test.txt',UID,GID)<>0 then
if fpgeterrno=ESysEPERM then
Writeln ('You are not root !')
else
Writeln ('Chmod failed with exit code : ',fpgeterrno)
else
Writeln ('Changed owner successfully !');
end.

24
docs/linuxex/ex25.pp
View File

@ -1,24 +0,0 @@
Program Example25;
{ Program to demonstrate the UTime function. }
Uses BaseUnix,Unix,UnixUtil;
Var utim : utimbuf;
year,month,day,hour,minute,second : Word;
begin
{ Set access and modification time of executable source }
GetTime (hour,minute,second);
GetDate (year,month,day);
utim.actime:=LocalToEpoch(year,month,day,hour,minute,second);
utim.modtime:=utim.actime;
if Fputime('ex25.pp',@utim)<>0 then
writeln ('Call to UTime failed !')
else
begin
Write ('Set access and modification times to : ');
Write (Hour:2,':',minute:2,':',second,', ');
Writeln (Day:2,'/',month:2,'/',year:4);
end;
end.

13
docs/linuxex/ex26.pp
View File

@ -1,13 +0,0 @@
Program Example26;
{ Program to demonstrate the Access function. }
Uses BaseUnix;
begin
if fpAccess ('/etc/passwd',W_OK)=0 then
begin
Writeln ('Better check your system.');
Writeln ('I can write to the /etc/passwd file !');
end;
end.

10
docs/linuxex/ex27.pp
View File

@ -1,10 +0,0 @@
Program Example27;
{ Program to demonstrate the Umask function. }
Uses BaseUnix;
begin
Writeln ('Old Umask was : ',fpUmask(&111));
WRiteln ('New Umask is : ',&111);
end.

39
docs/linuxex/ex28.pp
View File

@ -1,39 +0,0 @@
program example28;
{ Program to demonstrate the FStat function. }
uses BaseUnix;
var f : text;
i : byte;
info : stat;
begin
{ Make a file }
assign (f,'test.fil');
rewrite (f);
for i:=1 to 10 do writeln (f,'Testline # ',i);
close (f);
{ Do the call on made file. }
if fpstat ('test.fil',info)<>0 then
begin
writeln('Fstat failed. Errno : ',fpgeterrno);
halt (1);
end;
writeln;
writeln ('Result of fstat on file ''test.fil''.');
writeln ('Inode : ',info.st_ino);
writeln ('Mode : ',info.st_mode);
writeln ('nlink : ',info.st_nlink);
writeln ('uid : ',info.st_uid);
writeln ('gid : ',info.st_gid);
writeln ('rdev : ',info.st_rdev);
writeln ('Size : ',info.st_size);
writeln ('Blksize : ',info.st_blksize);
writeln ('Blocks : ',info.st_blocks);
writeln ('atime : ',info.st_atime);
writeln ('mtime : ',info.st_mtime);
writeln ('ctime : ',info.st_ctime);
{ Remove file }
erase (f);
end.

63
docs/linuxex/ex29.pp
View File

@ -1,63 +0,0 @@
program example29;
{ Program to demonstrate the LStat function. }
uses BaseUnix,Unix;
var f : text;
i : byte;
info : stat;
begin
{ Make a file }
assign (f,'test.fil');
rewrite (f);
for i:=1 to 10 do writeln (f,'Testline # ',i);
close (f);
{ Do the call on made file. }
if fpstat ('test.fil',info)<>0 then
begin
writeln('Fstat failed. Errno : ',fpgeterrno);
halt (1);
end;
writeln;
writeln ('Result of stat on file ''test.fil''.');
writeln ('Inode : ',info.st_ino);
writeln ('Mode : ',info.st_mode);
writeln ('nlink : ',info.st_nlink);
writeln ('uid : ',info.st_uid);
writeln ('gid : ',info.st_gid);
writeln ('rdev : ',info.st_rdev);
writeln ('Size : ',info.st_size);
writeln ('Blksize : ',info.st_blksize);
writeln ('Blocks : ',info.st_blocks);
writeln ('atime : ',info.st_atime);
writeln ('mtime : ',info.st_mtime);
writeln ('ctime : ',info.st_ctime);
If fpSymLink ('test.fil','test.lnk')<>0 then
writeln ('Link failed ! Errno :',fpgeterrno);
if fplstat ('test.lnk',@info)<>0 then
begin
writeln('LStat failed. Errno : ',fpgeterrno);
halt (1);
end;
writeln;
writeln ('Result of fstat on file ''test.lnk''.');
writeln ('Inode : ',info.st_ino);
writeln ('Mode : ',info.st_mode);
writeln ('nlink : ',info.st_nlink);
writeln ('uid : ',info.st_uid);
writeln ('gid : ',info.st_gid);
writeln ('rdev : ',info.st_rdev);
writeln ('Size : ',info.st_size);
writeln ('Blksize : ',info.st_blksize);
writeln ('Blocks : ',info.st_blocks);
writeln ('atime : ',info.st_atime);
writeln ('mtime : ',info.st_mtime);
writeln ('ctime : ',info.st_ctime);
{ Remove file and link }
erase (f);
fpunlink ('test.lnk');
end.

13
docs/linuxex/ex3.pp
View File

@ -1,13 +0,0 @@
Program Example3;
{ Program to demonstrate the EpochToLocal function. }
Uses Unix,UnixUtil;
Var Year,month,day,hour,minute,seconds : Word;
begin
EpochToLocal (GetEpochTime,Year,month,day,hour,minute,seconds);
Writeln ('Current date : ',Day:2,'/',Month:2,'/',Year:4);
Writeln ('Current time : ',Hour:2,':',minute:2,':',seconds:2);
end.

33
docs/linuxex/ex30.pp
View File

@ -1,33 +0,0 @@
program Example30;
{ Program to demonstrate the FSStat function. }
uses BaseUnix,Unix,UnixType;
var s : string;
info : tstatfs;
begin
writeln ('Info about current partition : ');
s:='.';
while s<>'q' do
begin
if statfs (s,info)<>0 then
begin
writeln('Fstat failed. Errno : ',fpgeterrno);
halt (1);
end;
writeln;
writeln ('Result of fsstat on file ''',s,'''.');
writeln ('fstype : ',info.fstype);
writeln ('bsize : ',info.bsize);
writeln ('bfree : ',info.bfree);
writeln ('bavail : ',info.bavail);
writeln ('files : ',info.files);
writeln ('ffree : ',info.ffree);
writeln ('fsid : ',info.fsid[0]);
writeln ('Namelen : ',info.namelen);
write ('Type name of file to do fsstat. (q quits) :');
readln (s)
end;
end.

15
docs/linuxex/ex31.pp
View File

@ -1,15 +0,0 @@
program Example31;
{ Program to demonstrate the Dup function. }
uses baseunix;
var f : text;
begin
if fpdup (output,f)<>0 then
Writeln ('Dup Failed !');
writeln ('This is written to stdout.');
writeln (f,'This is written to the dup file, and flushed');flush(f);
writeln
end.

22
docs/linuxex/ex32.pp
View File

@ -1,22 +0,0 @@
program Example31;
{ Program to demonstrate the Dup function. }
uses BaseUnix;
var f : text;
i : longint;
begin
Assign (f,'text.txt');
Rewrite (F);
For i:=1 to 10 do writeln (F,'Line : ',i);
if fpdup2 (output,f)<>0 then
Writeln ('Dup2 Failed !');
writeln ('This is written to stdout.');
writeln (f,'This is written to the dup file, and flushed');
flush(f);
writeln;
{ Remove file. Comment this if you want to check flushing.}
fpUnlink ('text.txt');
end.

25
docs/linuxex/ex33.pp
View File

@ -1,25 +0,0 @@
Program Example33;
{ Program to demonstrate the Select function. }
Uses BaseUnix;
Var FDS : Tfdset;
begin
fpfd_zero(FDS);
fpfd_set(0,FDS);
Writeln ('Press the <ENTER> to continue the program.');
{ Wait until File descriptor 0 (=Input) changes }
fpSelect (1,@FDS,nil,nil,nil);
{ Get rid of <ENTER> in buffer }
readln;
Writeln ('Press <ENTER> key in less than 2 seconds...');
Fpfd_zero(FDS);
FpFd_set (0,FDS);
if fpSelect (1,@FDS,nil,nil,2000)>0 then
Writeln ('Thank you !')
{ FD_ISSET(0,FDS) would be true here. }
else
Writeln ('Too late !');
end.

22
docs/linuxex/ex34.pp
View File

@ -1,22 +0,0 @@
Program Example33;
{ Program to demonstrate the SelectText function. }
Uses Unix;
Var tv : TimeVal;
begin
Writeln ('Press the <ENTER> to continue the program.');
{ Wait until File descriptor 0 (=Input) changes }
SelectText (Input,nil);
{ Get rid of <ENTER> in buffer }
readln;
Writeln ('Press <ENTER> key in less than 2 seconds...');
tv.tv_sec:=2;
tv.tv_sec:=0;
if SelectText (Input,@tv)>0 then
Writeln ('Thank you !')
else
Writeln ('Too late !');
end.

46
docs/linuxex/ex35.pp
View File

@ -1,46 +0,0 @@
Program Example35;
{ Program to demonstrate the
OpenDir,ReadDir, SeekDir and TellDir functions. }
Uses BaseUnix;
Var TheDir : PDir;
ADirent : PDirent;
Entry : Longint;
begin
TheDir:=fpOpenDir('./.');
Repeat
// Entry:=fpTellDir(TheDir);
ADirent:=fpReadDir (TheDir^);
If ADirent<>Nil then
With ADirent^ do
begin
Writeln ('Entry No : ',Entry);
Writeln ('Inode : ',d_fileno);
// Writeln ('Offset : ',d_off);
Writeln ('Reclen : ',d_reclen);
Writeln ('Name : ',pchar(@d_name[0]));
end;
Until ADirent=Nil;
Repeat
Write ('Entry No. you would like to see again (-1 to stop): ');
ReadLn (Entry);
If Entry<>-1 then
begin
// fpSeekDir (TheDir,Entry); // not implemented for various platforms
ADirent:=fpReadDir (TheDir^);
If ADirent<>Nil then
With ADirent^ do
begin
Writeln ('Entry No : ',Entry);
Writeln ('Inode : ',d_fileno);
// Writeln ('Offset : ',off);
Writeln ('Reclen : ',d_reclen);
Writeln ('Name : ',pchar(@d_name[0]));
end;
end;
Until Entry=-1;
fpCloseDir (TheDir^);
end.

25
docs/linuxex/ex36.pp
View File

@ -1,25 +0,0 @@
Program Example36;
{ Program to demonstrate the AssignPipe function. }
Uses BaseUnix,Unix;
Var pipi,pipo : Text;
s : String;
begin
Writeln ('Assigning Pipes.');
If assignpipe(pipi,pipo)<>0 then
Writeln('Error assigning pipes !',fpgeterrno);
Writeln ('Writing to pipe, and flushing.');
Writeln (pipo,'This is a textstring');close(pipo);
Writeln ('Reading from pipe.');
While not eof(pipi) do
begin
Readln (pipi,s);
Writeln ('Read from pipe : ',s);
end;
close (pipi);
writeln ('Closed pipes.');
writeln
end.

35
docs/linuxex/ex37.pp
View File

@ -1,35 +0,0 @@
Program Example37;
{ Program to demonstrate the Popen function. }
uses BaseUnix,Unix;
var f : text;
i : longint;
begin
writeln ('Creating a shell script to which echoes its arguments');
writeln ('and input back to stdout');
assign (f,'test21a');
rewrite (f);
writeln (f,'#!/bin/sh');
writeln (f,'echo this is the child speaking.... ');
writeln (f,'echo got arguments \*"$*"\*');
writeln (f,'cat');
writeln (f,'exit 2');
writeln (f);
close (f);
fpchmod ('test21a',&755);
popen (f,'./test21a arg1 arg2','W');
if fpgeterrno<>0 then
writeln ('error from POpen : errno : ', fpgeterrno);
for i:=1 to 10 do
writeln (f,'This is written to the pipe, and should appear on stdout.');
Flush(f);
Writeln ('The script exited with status : ',PClose (f));
writeln;
writeln ('Press <return> to remove shell script.');
readln;
assign (f,'test21a');
erase (f)
end.

51
docs/linuxex/ex38.pp
View File

@ -1,51 +0,0 @@
Program Example38;
{ Program to demonstrate the AssignStream function. }
Uses BaseUnix,Unix;
Var Si,So : Text;
S : String;
i : longint;
begin
if not (paramstr(1)='-son') then
begin
Writeln ('Calling son');
Assignstream (Si,So,'./ex38 -son');
if fpgeterrno<>0 then
begin
writeln ('AssignStream failed !');
halt(1);
end;
Writeln ('Speaking to son');
For i:=1 to 10 do
begin
writeln (so,'Hello son !');
if ioresult<>0 then writeln ('Can''t speak to son...');
end;
For i:=1 to 3 do writeln (so,'Hello chap !');
close (so);
while not eof(si) do
begin
readln (si,s);
writeln ('Father: Son said : ',S);
end;
Writeln ('Stopped conversation');
Close (Si);
Writeln ('Put down phone');
end
Else
begin
Writeln ('This is the son ');
While not eof (input) do
begin
readln (s);
if pos ('Hello son !',S)<>0 then
Writeln ('Hello Dad !')
else
writeln ('Who are you ?');
end;
close (output);
end
end.

9
docs/linuxex/ex39.pp
View File

@ -1,9 +0,0 @@
Program Example39;
{ Program to demonstrate the GetDomainName function. }
Uses Unix;
begin
Writeln ('Domain name of this machine is : ',GetDomainName);
end.

19
docs/linuxex/ex4.pp
View File

@ -1,19 +0,0 @@
Program Example4;
{ Program to demonstrate the LocalToEpoch function. }
Uses UnixUtil;
Var year,month,day,hour,minute,second : Word;
begin
Write ('Year : ');readln(Year);
Write ('Month : ');readln(Month);
Write ('Day : ');readln(Day);
Write ('Hour : ');readln(Hour);
Write ('Minute : ');readln(Minute);
Write ('Seonds : ');readln(Second);
Write ('This is : ');
Write (LocalToEpoch(year,month,day,hour,minute,second));
Writeln (' seconds past 00:00 1/1/1980');
end.

9
docs/linuxex/ex40.pp
View File

@ -1,9 +0,0 @@
Program Example40;
{ Program to demonstrate the GetHostName function. }
Uses unix;
begin
Writeln ('Name of this machine is : ',GetHostName);
end.

9
docs/linuxex/ex41.pp
View File

@ -1,9 +0,0 @@
Program Example41;
{ Program to demonstrate the GetEnv function. }
Uses BaseUnix;
begin
Writeln ('Path is : ',fpGetenv('PATH'));
end.

26
docs/linuxex/ex42.pp
View File

@ -1,26 +0,0 @@
Program Example42;
{ Program to demonstrate the SysInfo function. }
{$ifdef Linux} // is Linux specific.
Uses linux;
Var Info : TSysinfo;
{$endif}
begin
{$ifdef Linux}
If SysInfo (Info) then
With info do
begin
Writeln ('Uptime : ',uptime);
Writeln ('Load : ',loads[1],'/',Loads[2],'/',Loads[3]);
Writeln ('Total ram : ',TotalRam div 1024,'Kb.');
Writeln ('Free ram : ',FreeRam div 1024,'Kb.');
Writeln ('Shared ram : ',SharedRam div 1024,'Kb.');
Writeln ('Total swap : ',Totalswap div 1024,'Kb.');
Writeln ('Free swap : ',FreeSwap Div 1024,'Kb.');
Writeln ('No. Processes : ',procs);
end;
{$endif}
end.

22
docs/linuxex/ex43.pp
View File

@ -1,22 +0,0 @@
Program Example43;
{ Program to demonstrate the Uname function. }
Uses BaseUnix;
Var UN : utsname;
begin
if fpUname (UN)=0 then
With UN do
begin
Writeln ('Name : ',pchar(@sysname[0]));
Writeln ('Nodename : ',pchar(@Nodename[0]));
Writeln ('release : ',pchar(@Release[0]));
Writeln ('Version : ',pchar(@Version[0]));
Writeln ('Machine : ',pchar(@Machine[0]));
{$ifdef Linux} // linuxism
Writeln ('Domainname : ',pchar(@domainname[0]));
{$endif}
end;
end.

9
docs/linuxex/ex44.pp
View File

@ -1,9 +0,0 @@
Program Example44;
{ Program to demonstrate the Octal function. }
begin
// Writeln ('Octal(666) : ',octal(666));
Writeln (' &666 : ',&666); // 1.9.x+ functionality, octal is not necessary anymore
end.

9
docs/linuxex/ex45.pp
View File

@ -1,9 +0,0 @@
Program Example45;
{ Program to demonstrate the FExpand function. }
Uses Unix;
begin
Writeln ('This program is in : ',FExpand(Paramstr(0)));
end.

9
docs/linuxex/ex46.pp
View File

@ -1,9 +0,0 @@
Program Example46;
{ Program to demonstrate the FSearch function. }
Uses BaseUnix, Unix, Strings;
begin
Writeln ('ls is in : ',FSearch ('ls',strpas(fpGetenv('PATH'))));
end.

12
docs/linuxex/ex47.pp
View File

@ -1,12 +0,0 @@
Program Example47;
{ Program to demonstrate the DirName function. }
Uses Unix,UnixUtil;
Var S : String;
begin
S:=FExpand(Paramstr(0));
Writeln ('This program is in directory : ',Dirname(S));
end.

12
docs/linuxex/ex48.pp
View File

@ -1,12 +0,0 @@
Program Example48;
{ Program to demonstrate the BaseName function. }
Uses Unix,UnixUtil;
Var S : String;
begin
S:=FExpand(Paramstr(0));
Writeln ('This program is called : ',Basename(S,''));
end.

22
docs/linuxex/ex49.pp
View File

@ -1,22 +0,0 @@
Program Example49;
{ Program to demonstrate the Glob and GlobFree functions. }
Uses BaseUnix,Unix;
Var G1,G2 : PGlob;
begin
G1:=Glob ('*');
if fpgeterrno=0 then
begin
G2:=G1;
Writeln ('Files in this directory : ');
While g2<>Nil do
begin
Writeln (g2^.name);
g2:=g2^.next;
end;
GlobFree (g1);
end;
end.

12
docs/linuxex/ex5.pp
View File

@ -1,12 +0,0 @@
Program Example5;
{ Program to demonstrate the GetTime function. }
Uses Unix;
Var Hour, Minute, Second : Word;
begin
GetTime (Hour, Minute, Second);
Writeln ('Time : ',Hour:2,':',Minute:2,':',Second:2);
end.

16
docs/linuxex/ex51.pp
View File

@ -1,16 +0,0 @@
Program Example51;
{ Program to demonstrate the StringToPPChar function.
This function is pretty obsolete }
Uses UnixUtil;
var P : PPChar;
S : String;
begin
S:='/bin/ls -l -F';
P:=StringToPPChar(S,0);
Writeln ('Name : ',p^); inc(longint(p),4);
writeln ('Option 1 : ',p^); inc(longint(p),4);
writeln ('Option 2 : ',p^);
end.

12
docs/linuxex/ex52.pp
View File

@ -1,12 +0,0 @@
Program Example52;
{ Program to demonstrate the GetFileHandle (was : GetFS) function.
In 1.9.x it has been generalised over all platforms }
Uses SysUtils;
begin
Writeln ('File descriptor of input ',getFileHandle(input));
Writeln ('File descriptor of output ',getFileHandle(output));
Writeln ('File descriptor of stderr ',getFileHandle(stderr));
end.

27
docs/linuxex/ex53.pp
View File

@ -1,27 +0,0 @@
Program Example53;
{ Program to demonstrate the S_ISLNK function. }
Uses BaseUnix,Unix;
Var Info : Stat;
begin
if fpLStat (paramstr(1),@info)=0 then
begin
if fpS_ISLNK(info.st_mode) then
Writeln ('File is a link');
if fpS_ISREG(info.st_mode) then
Writeln ('File is a regular file');
if fpS_ISDIR(info.st_mode) then
Writeln ('File is a directory');
if fpS_ISCHR(info.st_mode) then
Writeln ('File is a character device file');
if fpS_ISBLK(info.st_mode) then
Writeln ('File is a block device file');
if fpS_ISFIFO(info.st_mode) then
Writeln ('File is a named pipe (FIFO)');
if fpS_ISSOCK(info.st_mode) then
Writeln ('File is a socket');
end;
end.

19
docs/linuxex/ex54.pp
View File

@ -1,19 +0,0 @@
Program Example54;
uses BaseUnix,Termio;
{ Program to demonstrate the IOCtl function. }
var
tios : Termios;
begin
{$ifdef FreeBSD}
fpIOCtl(1,TIOCGETA,@tios); // these constants are very OS dependant.
// see the tcgetattr example for a better way
{$endif}
WriteLn('Input Flags : $',hexstr(tios.c_iflag,8));
WriteLn('Output Flags : $',hexstr(tios.c_oflag,8));
WriteLn('Line Flags : $',hexstr(tios.c_lflag,8));
WriteLn('Control Flags: $',hexstr(tios.c_cflag,8));
end.

30
docs/linuxex/ex55.pp
View File

@ -1,30 +0,0 @@
Program Example55;
uses TermIO;
{ Program to demonstrate the TCGetAttr/TCSetAttr/CFMakeRaw functions. }
procedure ShowTermios(var tios:Termios);
begin
WriteLn('Input Flags : $',hexstr(tios.c_iflag,8)+#13);
WriteLn('Output Flags : $',hexstr(tios.c_oflag,8));
WriteLn('Line Flags : $',hexstr(tios.c_lflag,8));
WriteLn('Control Flags: $',hexstr(tios.c_cflag,8));
end;
var
oldios,
tios : Termios;
begin
WriteLn('Old attributes:');
TCGetAttr(1,tios);
ShowTermios(tios);
oldios:=tios;
Writeln('Setting raw terminal mode');
CFMakeRaw(tios);
TCSetAttr(1,TCSANOW,tios);
WriteLn('Current attributes:');
TCGetAttr(1,tios);
ShowTermios(tios);
TCSetAttr(1,TCSANOW,oldios);
end.

13
docs/linuxex/ex56.pp
View File

@ -1,13 +0,0 @@
program example56;
uses Unix;
{ Program to demonstrate the Shell function }
Var S : Longint;
begin
Writeln ('Output of ls -l *.pp');
S:=Shell ('ls -l *.pp');
Writeln ('Command exited wwith status : ',S);
end.

38
docs/linuxex/ex57.pp
View File

@ -1,38 +0,0 @@
Program example57;
{ Program to demonstrate the SigAction function.}
{
do a kill -USR1 pid from another terminal to see what happens.
replace pid with the real pid of this program.
You can get this pid by running 'ps'.
}
uses BaseUnix;
Var
oa,na : PSigActionRec;
Procedure DoSig(sig : cint);cdecl;
begin
writeln('Receiving signal: ',sig);
end;
begin
new(na);
new(oa);
na^.sa_Handler:=TSigaction(@DoSig);
fillchar(na^.Sa_Mask,sizeof(na^.sa_mask),#0);
na^.Sa_Flags:=0;
{$ifdef Linux} // Linux specific
na^.Sa_Restorer:=Nil;
{$endif}
if fpSigAction(SigUsr1,na,oa)<>0 then
begin
writeln('Error: ',fpgeterrno,'.');
halt(1);
end;
Writeln ('Send USR1 signal or press <ENTER> to exit');
readln;
end.

27
docs/linuxex/ex58.pp
View File

@ -1,27 +0,0 @@
Program example58;
{ Program to demonstrate the Signal function.}
{
do a kill -USR1 pid from another terminal to see what happens.
replace pid with the real pid of this program.
You can get this pid by running 'ps'.
}
uses BaseUnix;
Procedure DoSig(sig : cint);cdecl;
begin
writeln('Receiving signal: ',sig);
end;
begin
if fpSignal(SigUsr1,SignalHandler(@DoSig))=signalhandler(SIG_ERR) then
begin
writeln('Error: ',fpGetErrno,'.');
halt(1);
end;
Writeln ('Send USR1 signal or press <ENTER> to exit');
readln;
end.

21
docs/linuxex/ex59.pp
View File

@ -1,21 +0,0 @@
Program Example59;
{ Program to demonstrate the Alarm function. }
Uses BaseUnix;
Procedure AlarmHandler(Sig : cint);cdecl;
begin
Writeln ('Got to alarm handler');
end;
begin
Writeln('Setting alarm handler');
fpSignal(SIGALRM,SignalHandler(@AlarmHandler));
Writeln ('Scheduling Alarm in 10 seconds');
fpAlarm(10);
Writeln ('Pausing');
fpPause;
Writeln ('Pause returned');
end.

12
docs/linuxex/ex6.pp
View File

@ -1,12 +0,0 @@
Program Example6;
{ Program to demonstrate the GetDate function. }
Uses Unix;
Var Year, Month, Day : Word;
begin
GetDate (Year, Month, Day);
Writeln ('Date : ',Day:2,'/',Month:2,'/',Year:4);
end.

13
docs/linuxex/ex60.pp
View File

@ -1,13 +0,0 @@
Program Example6;
{ Program to demonstrate the GetDateTime function. }
Uses Unix;
Var Year, Month, Day, Hour, min, sec : Word;
begin
GetDateTime (Year, Month, Day, Hour, min, sec);
Writeln ('Date : ',Day:2,'/',Month:2,'/',Year:4);
Writeln ('Time : ',Hour:2,':',Min:2,':',Sec:2);
end.

24
docs/linuxex/ex61.pp
View File

@ -1,24 +0,0 @@
Program ex61;
{ Example program to demonstrate the CreateShellArgV function }
// note: CreateShellArgV is reasonbly obsolete in 1.9.x due to the new fpexec functions
uses Unix;
Var
S: String;
PP : PPchar;
I : longint;
begin
S:='script -a -b -c -d -e fghijk';
PP:=CreateShellArgV(S);
I:=0;
If PP<>Nil then
While PP[i]<>Nil do
begin
Writeln ('Got : "',PP[i],'"');
Inc(i);
end;
end.

28
docs/linuxex/ex62.pp
View File

@ -1,28 +0,0 @@
Program Example62;
{ Program to demonstrate the ReadLink function. }
Uses BaseUnix,Unix;
Var F : Text;
S : String;
begin
Assign (F,'test.txt');
Rewrite (F);
Writeln (F,'This is written to test.txt');
Close(f);
{ new.txt and test.txt are now the same file }
if fpSymLink ('test.txt','new.txt')<>0 then
writeln ('Error when symlinking !');
S:=fpReadLink('new.txt');
If S='' then
Writeln ('Error reading link !')
Else
Writeln ('Link points to : ',S);
{ Now remove links }
If fpUnlink ('new.txt')<>0 then
Writeln ('Error when unlinking !');
If fpUnlink ('test.txt')<>0 then
Writeln ('Error when unlinking !');
end.

9
docs/linuxex/ex63.pp
View File

@ -1,9 +0,0 @@
Program Example63;
{ Program to demonstrate the FRename function. }
Uses BaseUnix;
begin
FpRename (paramstr(1),paramstr(2));
end.

33
docs/linuxex/ex65.pp
View File

@ -1,33 +0,0 @@
Program example64;
{ Program to demonstrate the SigRaise function.}
uses Unix,BaseUnix;
Var
oa,na : PSigActionRec;
Procedure DoSig(sig : Longint);cdecl;
begin
writeln('Receiving signal: ',sig);
end;
begin
new(na);
new(oa);
na^.sa_handler:=TSigaction(@DoSig);
fillchar(na^.Sa_Mask,sizeof(na^.Sa_Mask),#0);
na^.Sa_Flags:=0;
{$ifdef Linux}
// this member is linux only, and afaik even there arcane
na^.Sa_Restorer:=Nil;
{$endif}
if fpSigAction(SigUsr1,na,oa)<>0 then
begin
writeln('Error: ',fpgeterrno);
halt(1);
end;
Writeln('Sending USR1 (',sigusr1,') signal to self.');
SigRaise(sigusr1);
end.

33
docs/linuxex/ex66.pp
View File

@ -1,33 +0,0 @@
Program Example66;
{ Program to demonstrate the MMap function. }
Uses BaseUnix,Unix;
Var S : String;
fd : cint;
Len : longint;
// args : tmmapargs;
P : PChar;
begin
s:='This is the string';
Len:=Length(S);
fd:=fpOpen('testfile.txt',O_wrOnly or o_creat);
If fd=-1 then
Halt(1);
If fpWrite(fd,S[1],Len)=-1 then
Halt(2);
fpClose(fd);
fd:=fpOpen('testfile.txt',O_rdOnly);
if fd=-1 then
Halt(3);
P:=Pchar(fpmmap(nil,len+1 ,PROT_READ or PROT_WRITE,MAP_PRIVATE,fd,0));
If longint(P)=-1 then
Halt(4);
Writeln('Read in memory :',P);
fpclose(fd);
if fpMUnMap(P,Len)<>0 Then
Halt(fpgeterrno);
end.

16
docs/linuxex/ex67.pp
View File

@ -1,16 +0,0 @@
Program Example67;
uses UnixUtil;
{ Program to demonstrate the FSplit function. }
var
Path,Name,Ext : string;
begin
FSplit(ParamStr(1),Path,Name,Ext);
WriteLn('Split ',ParamStr(1),' in:');
WriteLn('Path : ',Path);
WriteLn('Name : ',Name);
WriteLn('Extension: ',Ext);
end.

9
docs/linuxex/ex68.pp
View File

@ -1,9 +0,0 @@
Program Example68;
{ Program to demonstrate the Octal function. }
begin
Writeln('Mode 777 : ', &777);
Writeln('Mode 644 : ', &544);
Writeln('Mode 755 : ', &755);
end.

27
docs/linuxex/ex69.pp
View File

@ -1,27 +0,0 @@
Program Example69;
{ Program to demonstrate the FNMatch function. }
Uses unixutil;
Procedure TestMatch(Pattern,Name : String);
begin
Write ('"',Name,'" ');
If FNMatch (Pattern,Name) then
Write ('matches')
else
Write ('does not match');
Writeln(' "',Pattern,'".');
end;
begin
TestMatch('*','FileName');
TestMatch('.*','FileName');
TestMatch('*a*','FileName');
TestMatch('?ile*','FileName');
TestMatch('?','FileName');
TestMatch('.?','FileName');
TestMatch('?a*','FileName');
TestMatch('??*me?','FileName');
end.

21
docs/linuxex/ex7.pp
View File

@ -1,21 +0,0 @@
Program Example7;
{ Program to demonstrate the Execve function. }
Uses BaseUnix, strings;
Const Arg0 : PChar = '/bin/ls';
Arg1 : Pchar = '-l';
Var PP : PPchar;
begin
GetMem (PP,3*SizeOf(Pchar));
PP[0]:=Arg0;
PP[1]:=Arg1;
PP[3]:=Nil;
{ Execute '/bin/ls -l', with current environment }
{ Envp is defined in system.inc }
fpExecVe ('/bin/ls',pp,envp);
end.

22
docs/linuxex/ex70.pp
View File

@ -1,22 +0,0 @@
Program Example70;
{ Program to demonstrate the StringToPPchar function. }
Uses UnixUtil;
Var S : String;
P : PPChar;
I : longint;
begin
// remark whitespace at end.
S:='This is a string with words. ';
P:=StringToPPChar(S,0);
I:=0;
While P[i]<>Nil do
begin
Writeln('Word ',i,' : ',P[i]);
Inc(I);
end;
FreeMem(P,i*SizeOf(Pchar));
end.

27
docs/linuxex/ex72.pp
View File

@ -1,27 +0,0 @@
program example72;
{ Program to demonstrate the NanoSleep function. }
uses BaseUnix;
Var
Req,Rem : TimeSpec;
Res : Longint;
begin
With Req do
begin
tv_sec:=10;
tv_nsec:=100;
end;
Write('NanoSleep returned : ');
Flush(Output);
Res:=(fpNanoSleep(@Req,@rem));
Writeln(res);
If (res<>0) then
With rem do
begin
Writeln('Remaining seconds : ',tv_sec);
Writeln('Remaining nanoseconds : ',tv_nsec);
end;
end.

17
docs/linuxex/ex73.pp
View File

@ -1,17 +0,0 @@
program example73;
{ Program to demonstrate the FpSleep function. }
uses BaseUnix;
Var
Res : Longint;
begin
Write('Sleep returned : ');
Flush(Output);
Res:=(fpSleep(10));
Writeln(res);
If (res<>0) then
Writeln('Remaining seconds : ',res);
end.

19
docs/linuxex/ex74.pp
View File

@ -1,19 +0,0 @@
program example74;
uses baseunix;
Var
P : PGrpArr;
C,R,I : Cint;
begin
C:=5;
GetMem(P,Sizeof(tgid)*C);
FillChar(P^,Sizeof(tgid)*C,0);
R:=fpGetGroups(C,P^);
If (R>0) then
begin
For I:=0 to R-1 do
Writeln('Group id :',P^[I]);
end;
end.

21
docs/linuxex/ex75.pp
View File

@ -1,21 +0,0 @@
Program Example75;
{ Program to demonstrate the setsid function. }
Uses BaseUnix;
Var
Pid : pid_t;
begin
Writeln('Current process group: ',fpgetpgrp);
// Force non-process group leader.
Pid:=fpFork;
if (Pid=0) then
begin
Writeln('SetSid returned : ',FpSetSid);
Writeln('New process group: ',fpgetpgrp);
end
else
Writeln('Child PID :',Pid);
end.

12
docs/linuxex/ex76.pp
View File

@ -1,12 +0,0 @@
Program Example76;
{ Program to demonstrate the FpExeclp function. }
Uses Unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is looked for in PATH environment variable.}
{ envp is defined in the system unit.}
FpExeclp ('ls',['-l']);
end.

11
docs/linuxex/ex77.pp
View File

@ -1,11 +0,0 @@
Program Example77;
{ Program to demonstrate the FPExecL function. }
Uses Unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is NOT looked for in PATH environment variable.}
FpExecL ('/bin/ls',['-l']);
end.

12
docs/linuxex/ex78.pp
View File

@ -1,12 +0,0 @@
Program Example77;
{ Program to demonstrate the FPExecle function. }
Uses Unix, strings;
begin
{ Execute 'ls -l', with current environment. }
{ 'ls' is NOT looked for in PATH environment variable.}
{ envp is defined in the system unit.}
FpExecLE ('/bin/ls',['-l'],envp);
end.

21
docs/linuxex/ex79.pp
View File

@ -1,21 +0,0 @@
Program Example79;
{ Program to demonstrate the FpExecVP function. }
Uses Unix, strings;
Const Arg0 : PChar = 'ls';
Arg1 : Pchar = '-l';
Var PP : PPchar;
begin
GetMem (PP,3*SizeOf(Pchar));
PP[0]:=Arg0;
PP[1]:=Arg1;
PP[2]:=Nil;
{ Execute 'ls -l', with current environment. }
{ 'ls' is looked for in PATH environment variable.}
fpExecvp ('ls',pp);
end.

20
docs/linuxex/ex8.pp
View File

@ -1,20 +0,0 @@
Program Example8;
{ Program to demonstrate the Execv function. }
Uses Unix, strings;
Const Arg0 : PChar = '/bin/ls';
Arg1 : Pchar = '-l';
Var PP : PPchar;
begin
GetMem (PP,3*SizeOf(Pchar));
PP[0]:=Arg0;
PP[1]:=Arg1;
PP[3]:=Nil;
{ Execute '/bin/ls -l', with current environment }
fpExecv ('/bin/ls',pp);
end.

13
docs/linuxex/ex80.pp
View File

@ -1,13 +0,0 @@
program example56;
uses Unix;
{ Program to demonstrate the Shell function }
Var S : Longint;
begin
Writeln ('Output of ls -l *.pp');
S:=fpSystem('ls -l *.pp');
Writeln ('Command exited wwith status : ',S);
end.

22
docs/linuxex/ex9.pp
View File

@ -1,22 +0,0 @@
Program Example9;
{ Program to demonstrate the Execvp function. }
Uses Unix, strings;
Const Arg0 : PChar = 'ls';
Arg1 : Pchar = '-l';
Var PP : PPchar;
begin
GetMem (PP,3*SizeOf(Pchar));
PP[0]:=Arg0;
PP[1]:=Arg1;
PP[2]:=Nil;
{ Execute 'ls -l', with current environment. }
{ 'ls' is looked for in PATH environment variable.}
{ Envp is defined in the system unit. }
fpExecvpe ('ls',pp,envp);
end.

44
docs/linuxex/ex91.pp
View File

@ -1,44 +0,0 @@
program Example30;
{ Program to demonstrate the FSStat function. }
uses BaseUnix,Unix,UnixType;
var s : string;
fd : cint;
info : tstatfs;
begin
writeln ('Info about current partition : ');
s:='.';
while s<>'q' do
begin
Fd:=fpOpen(S,O_RDOnly);
if (fd>=0) then
begin
if fstatfs (fd,info)<>0 then
begin
writeln('Fstat failed. Errno : ',fpgeterrno);
halt (1);
end;
FpClose(fd);
writeln;
writeln ('Result of fsstat on file ''',s,'''.');
writeln ('fstype : ',info.fstype);
writeln ('bsize : ',info.bsize);
writeln ('bfree : ',info.bfree);
writeln ('bavail : ',info.bavail);
writeln ('files : ',info.files);
writeln ('ffree : ',info.ffree);
{$ifdef FreeBSD}
writeln ('fsid : ',info.fsid[0]);
{$else}
writeln ('fsid : ',info.fsid[0]);
writeln ('Namelen : ',info.namelen);
{$endif}
write ('Type name of file to do fsstat. (q quits) :');
readln (s)
end;
end;
end.

167
docs/linuxex/serial.pp
View File

@ -1,167 +0,0 @@
program Terminal_test;
{******************************************************************************
* Really really budget attempt at Serial IO with Linux and FPC.
* My first FPC program. Re-built and refined on 12/6/99
* Written under X windows with nedit 5.0.2 (Not a bad editor)
* This SHOULD work without including the CRT Unit, However it has problems
* With reading from the keyboard unless the CRT unit is included ?!?
*
* Designed to talk to an RS485 Buss, using RTS as the Tx/Rx Select Pin
* No Copyrights or warrantys.
* Let me know if it's of some use to you.
* Brad Campbell (bcampbel@omen.net.au)
******************************************************************************}
uses Linux, Crt;
Const DTR : Cardinal = TIOCM_DTR;
Const RTS : Cardinal = TIOCM_RTS;
Var FD : Longint;
InChr : String[1];
InStr : String[80];
Quit : Boolean;
InLen, Loop : Integer;
tios : Termios;
fds : FDSet;
Procedure DumpFlags;
begin
IOCtl(FD,TIOCMGET,@tios);
Writeln('Input Flags : $',hexstr(tios.c_iflag,8));
Writeln('Output Flags : $',hexstr(tios.c_oflag,8));
Writeln('Local Flags : $',hexstr(tios.c_lflag,8));
Writeln('Control Flags : $',hexstr(tios.c_cflag,8));
End;
Procedure RS485RX;
Begin
IOCtl(FD,TIOCMBIS,@RTS);
End;
Procedure RS485TX;
Begin
IOCtl(FD,TIOCMBIC,@RTS);
End;
Procedure DtrOn;
Begin
IOCtl(FD,TIOCMBIS,@DTR);
End;
Procedure DtrOff;
Begin
IOCtl(FD,TIOCMBIC,@DTR);
End;
Procedure SendToRemote(OutString : String);
Begin
Rs485TX; {Switch Buss to Transmit}
if fdWrite(FD,OutString[1],Length(OutString)) <> Length(OutString) then
Writeln('Write Error');
{Write(OutString);} {Uncomment for Local Echo}
TCDrain(FD); {Block Program until all data sent out port has left UART}
RS485RX; {Switch Buss back to Recieve}
End;
{ Not limited to baud selection I have here, it's just all I use }
Procedure SetBaudrate;
Var NewBaud : LongInt;
Begin
Writeln;
Writeln('New Baud Rate (300,1200,2400,4800, 9600,19200,38400) ? ');
Readln(NewBaud);
Case NewBaud of
300 : NewBaud := B300;
1200 : NewBaud := B1200;
2400 : NewBaud := B2400;
4800 : NewBaud := B4800;
9600 : NewBaud := B9600;
19200 : NewBaud := B19200;
38400 : NewBaud := B38400;
Else
Begin
Writeln('Invalid Baud Rate. Baud not Changed');
Writeln;
NewBaud := 0;
End;
End;
{ Sets Baud Rate Here }
If NewBaud <> 0 then
Begin
IOCtl(FD,TCGETS,@tios); {Get IOCTL TermIOS Settings}
CFSetOSpeed(tios,NewBaud); {Set Relevant Bits}
IOCtl(FD,TCSETS,@tios); {Put them back with IOCTL}
Writeln('New Baudrate ',HexStr(NewBaud,2),' Set');
{This line just prints what the constant equates to for
Information Only}
End;
End;
Begin
Quit := False;
Writeln('Brad''s Dumb Terminal Test prog v0.2');
Writeln('Ctrl-C to exit program');
Writeln('Ctrl-D to set Baud Rate');
Writeln('Uses /dev/ttyS0 (Com 1)');
Writeln;
FD:=fdOpen('/dev/ttyS0',Open_RdWr or Open_NonBlock or Open_Excl);
{Open Port Read/Write, Not Blocking and Exclusive}
if FD > 0 then Begin
Writeln('Port Open');
FLock(FD,LOCK_EX);
{Attempt to Lock the port, I'm not sure this is strictly nessecary}
Writeln('Port Locked');
{Set Comms Parms, 9600 Baud, 8 Data Bits, Reciever Enabled,
Modem Control Lines Ignored}
{Read man 3 termios for More options}
IOCtl(FD,TCGETS,@tios);
tios.c_cflag := B9600 Or CS8 Or CREAD Or CLOCAL;
tios.c_lflag := 0;
tios.c_oflag := 0;
tios.c_iflag := 0;
IOCtl(FD,TCSETS,@tios);
DumpFlags; {This is for information only and dumps the contents of
the Termios registers}
Repeat
FD_Zero (FDS); {Clear File Descriptors Array}
FD_Set (0,FDS); {Input from Keyboard}
FD_SET (FD,FDS); {Input from Serial Port}
Select(FD+1,@FDS,nil,nil,nil); {Will Wait for input from above}
If FD_ISSET(0,FDS) then {Has there been a key pressed ?}
If fdRead(0,InChr[1],80) <> 0 then
Begin
if InChr[1] = Chr(3) then Quit := True;
if InChr[1] = Chr(4) then SetBaudRate;
SendToRemote(InChr[1]);
End;
If FD_ISSET(FD,FDS) then {Have we data waiting in UART ? }
Begin
InLen := fdRead(FD,InStr[1],80);
If InLen > 0 then
For Loop := 1 to Inlen do
Write(InStr[Loop]);
End;
Until Quit = True; {Were Outa Here}
FLock(FD,LOCK_UN); {Unlock Port}
fdClose(FD); {Close Port}
End
Else Writeln('Open Port Error'); {We failed to Open/Lock the UART}
End.