一、字符、字符串类型的使用

　　（一）字符类型

　　字符类型为由一个字符组成的字符常量或字符变量 。
　　字符常量定义:
　　const　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　字符常量='字符'
　　字符变量定义:Ⅱ
　　Var
　　　字符变量:char;

　　字符类型是一个有序类型, 字符的大小顺序按其ASCⅡ代码的大小而定。函数succ、pred、ord适用于字符类型。
　　例如：后继函数：succ('a')='b'
　　　　　前继函数：pred（'B'）='A'
　　　　　序号函数：ord（'A'）=65

　　例1 按字母表顺序和逆序每隔一个字母打印。即打印出：
　　　　a c e g I k m o q s u w y
　　　　z x r v t p n l j h f d b

　　程序如下：

　　program ex8_1;
　　　var letter:char;
　　　begin
　　　　for letter:='a' to 'z' do
　　　　if (ord(letter)-ord('a'))mod 2=0 then write(letter:3);
　　　　writeln;
　　　　for letter:='z' downto 'a' do
　　　　if (ord(letter)-ord('z'))mod 2 =0 then write(letter:3);
　　　writeln;
　　end.
　　分析：程序中，我们利用了字符类型是顺序类型这一特性，直接将字符类型变量作为循环变量，使程序处理起来比较直观。

　　（二）字符串类型

　　字符串是由字符组成的有穷序列。
　　字符串类型定义：
　　type <字符串类型标识符>=string[n];
　　var
　　　字符串变量: 字符串类型标识符;
　　其中:n是定义的字符串长度,必须是0~255之间的自然整数,第0号单元中存放串的实际长度,程序运行时由系统自动提供,第1~n号单元中存放串的字符。若将string[n]写成string，则默认n值为255。

　　例如：type
　　　　　　man=string[8]；
　　　　　　　line=string；
　　　　　　var
　　　　　　　name：man；
　　　　　　　screenline：line；

　　另一种字符类型的定义方式为把类型说明的变量定义合并在一起。
　　例如：VAR
　　　　　　　name：STRING[8]；
　　　　　　　screenline：STRING；
　　Turbo Pascal中，一个字符串中的字符可以通过其对应的下标灵活使用。

　　例如：var
　　　　　　name：string；
　　　　　begin
　　　　　　readln（nsme）；
　　　　　　for i：=1 to ord（name[0]）do
　　　　　　　writeln（name[i]）；
　　　　　end.
　　语句writeln（name[i]）输出name串中第i个字符。

　　例2 求输入英文句子单词的平均长度.

　　程序如下:
　　program ex8_2;
　　　var
　　　　ch:string;
　　　　s,count,j:integer;
　　　begin
　　　　write('The sentence is :');
　　　　readln(ch);
　　　　s:=0;
　　　　count:=0;
　　　　j:=0;
　　　　repeat
　　　　　inc(j);
　　　　　if not (ch[j] in [':',',',';','''','!','?','.',' ']) then inc(s);
　　　　　if ch[j] in[' ','.','!','?'] then inc(count);
　　　　until (j=ord（ch[0])) or (ch[j] in ['.','!','?']);
　　　　if ch[j]<>'.' then writeln('It is not a sentence.')
　　　　else writeln('Average length is ',s/count:10:4);
　　　end.

　　分析:程序中，变量s用于存句子中英文字母的总数，变量count用于存放句子中单词的个数，ch[j]表示ch串中的第j个位置上的字符，ord（ch[0]）为ch串的串长度。程序充分利用Turbo Pascal允许直接通过字符串下标得到串中的字符这一特点，使程序比较简捷。

二、字符串的操作

　　（一）字符串的运算和比较

　　由字符串的常量、变量和运算符组成的表达式称为字符串表达式。
　　字符串运算符包括：

　　1．+：连接运算符

　　例如：'Turbo '+'PASCAL'的结果是'Turbo PASCAL'。
　　若连接的结果字符串长度超过255，则被截成255个字符。若连接后的字符串存放在定义的字符串变量中，当其长度超过定义的字符串长度时，超过部份字符串被截断。

　　例如：var
　　　　　　str1，str2，str3：string[8]；
　　　　　begin
　　　　　　str1：='Turbo '；
　　　　　　str2：='PASCAL'；
　　　　　　str3：=str1+str2；
　　　　　end．
　　则str3的值为：'Turbo PA'。

　　2．=、〈〉、〈、〈=、〉、〉=：关系运算符

　　两个字符串的比较规则为，从左到右按照ASCⅡ码值逐个比较，遇到ASCⅡ码不等时,规定ASCⅡ码值大的字符所在的字符串为大。
　　例如：'AB'〈'AC' 结果为真；
　　　　　'12'〈'2' 结果为真；
　　　　　'PASCAL '='PASCAL' 结果为假；

　　例3 对给定的10个国家名，按其字母的顺序输出。

　　程序如下：
　　program ex8_3;
　　　var i,j,k:integer;
　　　　　t:string[20];
　　　　　cname:array[1..10] of string[20];
　　　begin
　　　　for i:=1 to 10 do readln(cname[i]);
　　　　for i:=1 to 9 do
　　　　　begin
　　　　　　k:=i;
　　　　　　for j:=i+1 to 10 do
　　　　　　　if cname[k]>cname[j] then k:=j;
　　　　　　t:=cname[i];cname[i]:=cname[k];cname[k]:=t;
　　　　　end;
　　　　for i:=1 to 10 do writeln(cname[i]);
　　　end.
　　分析：程序中，当执行到if cname[k]>cname[j]时，自动将cname[k]串与cname[j]串中的每一个字符逐个比较，直至遇到不等而决定其大小。这种比较方式是计算机中字符串比较的一般方式。

三、字符串的函数和过程


　　Turbo Pascal提供了八个标准函数和标准过程，见下表，利用这些标准函数与标准过程，一些涉及到字符串的问题可以灵活解决。

函数和过程名 功 能 说 明
copy(s,m,n) 取s中第m个字符开始的n个字符 若m大于s的长度，则返回空串；否则，若m+n大于s的长度，则截断
length(s) 求s的动态的长度 返回值为整数
pos(sub,s) 在s中找子串sub 返回值为sub在s中的位置，为byte型
insert(sour,s,m) 在s的第m个字符位置处插入子串sour 若返回串超过255，则截断
delete(s,m,n) 删除s中第m个字符开始的n个字符串 若m大于s的长度，则不删除；否则，若m+n大于s的长度，则删除到结尾
str(x[:w[:d]],s) 将整数或实数x转换成字符串s w 和 d是整型表达式，意义同带字宽的write语句
val(s,x,code) 将字符串S 转换成整数或实数x
若S中有非法字符，则code存放非法字符在S中的下标；否则，code为零。code为整型
upcase(ch) 将字母ch转换成大写字母 若ch不为小写字母，则不转换


　

例4 校对输入日期(以标准英语日期,月/日/年)的正确性，若输入正确则以年．月．日的方式输出。
　　程序如下:
　　program ex8_4;
　　　const
　　　　max:array[1..12] of byte
　　　　　　=(31,29,31,30,31,30,31,31,30,31,30,31);
　　　var
　　　　st:string;
　　　　p,w,y,m,d:integer;
　　　procedure err;
　　　　begin
　　　　　write('Input Error!');
　　　　　readln;
　　　　　halt;
　　　　end;
　　　procedure init(var x:integer);
　　　　begin
　　　　　p:=pos('/',st);
　　　　　if (p=0) or (p=1) or (p>3) then err;
　　　　　val(copy(st,1,p-1),x,w);
　　　　　if w<>0 then err;
　　　　　delete(st,1,p);
　　　　end;
　　　begin
　　　　write('The Date is :');
　　　　readln(st);
　　　　init(m);
　　　　init(d);
　　　　val(st,y,w);
　　　　if not (length(st)<>4) or (w<>0) or (m>12) or (d>max

­) then err;
　　　　if (m=2) and (d=29)
　　　　　then if y mod 100=0
　　　　　　　　then begin
　　　　　　　　　　　　if y mod 400<>0 then err;
　　　　　　　　　　　end
　　　　　else if y mod 4<>0 then err;
　　　　write('Date : ',y,'.',m,'.',d);
　　　　readln;
　　　end.
　　分析：此题的题意很简单，但在程序处理时还需考虑以下几方面的问题。
　　1．判定输入的月和日应是１位或２位的数字，程序中用了一个过程inst，利用串函数pos，求得分隔符/所在的位置而判定输入的月和日是否为１位或２位，利用标准过程val判定输入的月和日是否为数字；
　　2．判定月和日是否规定的日期范围及输入的年是否正确；
　　3．若输入的月是2月份，则还需考虑闰年的情况。

　　例5 对输入的一句子实现查找且置换的功能。
　　程序如下:
　　program ex8_5;
　　var
　　　s1,s,o:string;
　　　i:integer;
　　begin
　　　write('The text:');
　　　readln(s1);
　　　write('Find:');readln(s);
　　　write('Replace:');readln(o);
　　　i:=pos(s,s1);
　　　while i<>0 do begin
　　　　delete(s1,i,length(s));
　　　　insert(o,s1,i);
　　　　i:=pos(s,s1);
　　　end;
　　　writeln(s1);
　　　readln;
　　end.

　　分析:程序中,输入要查找的字符串及要置换的字符串,充分用上了字符串处理的标准过程delete、insert及标准函数pos。
////////////////////////////////////////////////////////
{判断字符是否是数字}
function IsDigit(ch: char): boolean;
begin
Result := ch in ['0'..'9'];
end;
{判断字符是否是大写字符}
function IsUpper(ch: char): boolean;
begin
Result := ch in ['A'..'Z'];
end;
{判断字符是否是小写字符}
function IsLower(ch: char): boolean;
begin
Result := ch in ['a'..'z'];
end;
{转换为大写字符}
function ToUpper(ch: char): char;
begin
Result := chr(ord(ch) and $DF);
end;
{转换为小写字符}
function ToLower(ch: char): char;
begin
Result := chr(ord(ch) or $20);
end;
{ Capitalizes first letter of every word in s }
function Proper(const s: string): string;
var
i: Integer;
CapitalizeNextLetter: Boolean;
begin
Result := LowerCase(s);
CapitalizeNextLetter := True;
for i := 1 to Length(Result) do
begin
if CapitalizeNextLetter and IsLower(Result[i]) then
Result[i] := ToUpper(Result[i]);
CapitalizeNextLetter := Result[i] = ' ';
end;
end;
////////////////////////////////////////////////////////////
{返回两个子字符串之间字符的个数}
Function p2pcount( s, ss1, ss2 : string ): integer;
var i, j, slen : integer;
begin
i := pos( ss1, s );
j := pos( ss2, s );
slen := Length(ss2);
if j >= i then Result := j - i + slen else Result := 0;
end;
{更快速的字符查询,快40%}
function ScanStr(ToScan: PChar; Sign: Char):PChar;
begin
Result:= nil;
if ToScan <> nil then
while (ToScan^ <> #0) do begin
if ToScan^ = Sign then begin
Result:= ToScan;
break;
end;
inc(ToScan);
end;
end;
/////////////////////////////
替换字符串中子串的函数,他可以从字符串中找出指定子串,并替换为另一子串。
function replacing(S,source,target:string):string;
var site,StrLen:integer;
begin
{source在S中出现的位置}
site:=pos(source,s);
{source的长度}
StrLen:=length(source);
{删除source字符串}
delete(s,site,StrLen);
{插入target字符串到S中}
insert(target,s,site);
{返回新串}
replacing:=s;
end;
///////////////////////
另两个替换字符串中子串的函数
function repl_substr( sub1, sub2, s: string ): string;
var i: integer;
begin
repeat
i := pos( sub1, s ) ;
if i > 0 then begin
delete( s, i, Length(sub1));
insert( sub2, s, i );
end;
until i < 1;
Result := s;
end;
function ReplaceText(const S,ReplacePiece,ReplaceWith: String):String;
Var Position: Integer;
TempStr: String;
begin
Position := Pos(ReplacePiece,S);
if Position > 0 then Begin
TempStr := S;
Delete(TempStr,1,Position-1+Length(ReplacePiece));
Result :=
Copy(S,1,Position-1)+ReplaceWith+ReplaceText(TempStr,ReplacePiece,ReplaceWith)
End else Result := S;
end;
////////////////////////
替换全部子字符串的函数
function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1));
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;
/////////////////////////
在字符串左右填充指定数量的指定字符
function UT_PadString(inString :string; maxLength :integer; padChar :char;
left :boolean) :string;
begin
result := inString;
while (Length(result) < maxLength) do
if (left) then
result := padChar + result
else
result := result + padChar;
end;
/////////////////////////////////////
提取字符串中指定子字符串前的字符串
Function Before ( Src:string ; Var S:string ) : string ;
Var
F : Word ;
begin
F := POS (Src,S) ;
if F=0 then
Before := S
else
Before := COPY(S,1,F-1) ;
end ;
//////////////////////////////////
提取字符串中指定子字符串后的字符串
Function After ( Src:string ; Var S:string ) : string ;
Var
F : Word ;
begin
F := POS (Src,S) ;
if F=0 then
After := ''
else
After := COPY(S,F+length(src),length(s)) ;
end ;
////////////////////////////////////
判断字符串是否可以转换为整数
function IsIntStr(const S: string): boolean;
begin
Result:=StrToIntDef(S,0)=StrToIntDef(S,1);
end;
//////////////////////////////////////
从字符串中删除指定字符串
procedure RemoveInvalid(what, where: string): string;
var
tstr: string;
begin
tstr:=where;
while pos(what, tstr)>0 do
tstr:=copy(tstr,1,pos(what,tstr)-1) +
copy(tstr,pos(what,tstr)+length(tstr),length(tstr));
Result:=tstr;
end;
用法:
NewStr:=RemoveInvalid('','This is my string and I wan to
remove the word ');
///////////////////////////////////////////
根据某个字符分割字符串的函数
procedure SeparateTerms(s : string;Separator : char;Terms : TStringList);
{ This browses a string and divide it into terms whenever the given
separator is found. The separators will be removed }
var
hs : string;
p : integer;
begin
Terms.Clear; // First remove all remaining terms
if Length(s)=0 then // Nothin' to separate
Exit;
p:=Pos(Separator,s);
while P<>0 do
begin
hs:=Copy(s,1,p-1); // Copy term
Terms.Add(hs); // Add to list
Delete(s,1,p); // Remove term and separator
p:=Pos(Separator,s); // Search next separator
end;
if Length(s)>0 then
Terms.Add(s); // Add remaining term
end;
==========
= 用 法
==========
var
Terms : TStringList;
i : integer;
const
TestStr = '1st term;2nd term;3rd term';
begin
Terms:=TStringList.Create;
SeparateTerms(TestStr,';',Terms);
for i:=0 to terms.Count-1 do
ShowMessage(Terms.Strings[i]);
Terms.Free;
end;
/////////////////////////////
根据一组字符分割字符串的函数
type
Charset = set of Char;
var
f : Text;
s : String;
procedure WriteStringSplitted(var s: String; Separators: Charset);
var
a,e : Integer; {anfang und ende des w鰎tchens}
begin
a := 1;
for e := 1 to Length(s) do
if s[e] in Separators then begin
WriteLn(Copy(s, a, e-a));
a := e + 1;
end;
WriteLn(Copy(s, a, e-a+1));
end;
begin
Assign(f, 'c:\dingsbums\text.txt');
Reset(f);
while not EOF(f) do begin
ReadLn(f,s);
WriteStringSplitted(s, [':', ',']);
end;
Close(f);
end.
//////////////////////////////////////////////////
{===============================================================}
{ 函数 : RESULTSTRING = HexToBin(HEXSTRING)
{ 目的 : 把十六进制字符串转换为二进制字符串
{
{===============================================================}
{ 函数 : RESULTINTEGER = HexCharToInt(HEXCHAR)
{ 目的 : 转换一个十六进制字符为整数
{===============================================================}
{ 函数 : RESULTSTRING = HexCharToBin(HEXCHAR)
{ 目的 : 转换一个十六进制字符为二进制字符串
{===============================================================}
{ 函数 : RESULTINTEGER = Pow(BASE,POWER)
{ 目的 : 指数函数
{===============================================================}
{ 函数 : RESULTINTEGER = BinStrToInt(BINSTRING)
{ 目的 : 把二进制字符串转换为整数
{===============================================================}
{ 函数 : RESULTSTRING = DecodeSMS7Bit (PDUSTRING)
{ 目的 : 解码一个7-bit SMS (GSM 03.38) 为ASCII码
{===============================================================}
{ 函数 : RESULTSTRING = ReverseStr (SOURCESTRING)
{ 目的 : 反转一个字符串
{===============================================================}
unit BinHexTools;
interface
function HexToBin(HexNr : string): string;
function HexCharToInt(HexToken : char):Integer;
function HexCharToBin(HexToken : char): string;
function pow(base, power: integer): integer;
function BinStrToInt(BinStr : string) : integer;
function DecodeSMS7Bit(PDU : string):string;
function ReverseStr(SourceStr : string) : string;
implementation
uses sysutils, dialogs;
function HexCharToInt(HexToken : char):Integer;
begin
{if HexToken>#97 then HexToken:=Chr(Ord(HexToken)-32);
{ use lowercase aswell }
Result:=0;
if (HexToken>#47) and (HexToken<#58) then { chars 0....9 }
Result:=Ord(HexToken)-48
else if (HexToken>#64) and (HexToken<#71) then { chars A....F }
Result:=Ord(HexToken)-65 + 10;
end;
function HexCharToBin(HexToken : char): string;
var DivLeft : integer;
begin
DivLeft:=HexCharToInt(HexToken); { first HEX->BIN }
Result:='';
{ Use reverse dividing }
repeat { Trick; divide by 2 }
if odd(DivLeft) then { result = odd ? then bit = 1 }
Result:='1'+Result { result = even ? then bit = 0 }
else
Result:='0'+Result;
DivLeft:=DivLeft div 2; { keep dividing till 0 left and length = 4 }
until (DivLeft=0) and (length(Result)=4); { 1 token = nibble = 4 bits }
end;
function HexToBin(HexNr : string): string;
{ only stringsize is limit of binnr }
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(HexNr) do
Result:=Result+HexCharToBin(HexNr[Counter]);
end;
function pow(base, power: integer): integer;
var counter : integer;
begin
Result:=1;
for counter:=1 to power do
Result:=Result*base;
end;
function BinStrToInt(BinStr : string) : integer;
var counter : integer;
begin
if length(BinStr)>16 then
raise ERangeError.Create(#13+BinStr+#13+
'is not within the valid range of a 16 bit binary.'+#13);
Result:=0;
for counter:=1 to length(BinStr) do
if BinStr[Counter]='1' then
Result:=Result+pow(2,length(BinStr)-counter);
end;
function DecodeSMS7Bit(PDU : string):string;
var OctetStr : string;
OctetBin : string;
Charbin : string;
PrevOctet: string;
Counter : integer;
Counter2 : integer;
begin
PrevOctet:='';
Result:='';
for Counter:=1 to length(PDU) do
begin
if length(PrevOctet)>=7 then { if 7 Bit overflow on previous }
begin
if BinStrToInt(PrevOctet)<>0 then
Result:=Result+Chr(BinStrToInt(PrevOctet))
else Result:=Result+' ';
PrevOctet:='';
end;
if Odd(Counter) then { only take two nibbles at a time }
begin
OctetStr:=Copy(PDU,Counter,2);
OctetBin:=HexToBin(OctetStr);
Charbin:='';
for Counter2:=1 to length(PrevOctet) do
Charbin:=Charbin+PrevOctet[Counter2];
for Counter2:=1 to 7-length(PrevOctet) do
Charbin:=OctetBin[8-Counter2+1]+Charbin;
if BinStrToInt(Charbin)<>0 then Result:=Result+Chr(BinStrToInt(CharBin))
else Result:=Result+' ';
PrevOctet:=Copy(OctetBin,1,length(PrevOctet)+1);
end;
end;
end;
function ReverseStr(SourceStr : string) : string;
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(SourceStr) do
Result:=SourceStr[Counter]+Result;
end;
end.