回复人： zswang(伴水)(被黑中) (2001-12-12 22:46:10) 得0分
//建议收录
function StringGridToString(mStringGrid: TStringGrid): string;
var
I, J: Integer;
T: string;
begin
Result := '';
for J := 0 to mStringGrid.RowCount - 1 do begin
T := '';
for I := 0 to mStringGrid.ColCount - 1 do
T := T + #9 + mStringGrid.Cells[I, J];
Delete(T, 1, 1);
Result := Result + T + #13#10;
end;
end; { StringGridToString }
procedure StringToStringGrid(mStr: string; mStringGrid: TStringGrid);
var
I, J: Integer;
T: string;
begin
with TStringList.Create do try
Text := mStr;
for I := 0 to mStringGrid.ColCount - 1 do begin
T := '';
for J := 0 to Min(mStringGrid.RowCount - 1, Count - 1) do
mStringGrid.Cells[I, J] := ListValue(Strings[J], I, #9);
end;
finally
Free;
end;
end; { StringToStringGrid }
uses
Math;
function QuotedPrintableEncode(mSource: string): string;
var
I, J: Integer;
begin
Result := '';
J := 0;
for I := 1 to Length(mSource) do begin
if mSource[I] in [#32..#127, #13, #10] - ['='] then begin
Result := Result + mSource[I];
Inc(J);
end else begin
Result := Result + '=' + IntToHex(Ord(mSource[I]), 2);
Inc(J, 3);
end;
if mSource[I] in [#13, #10] then J := 0;
if J >= 70 then begin
Result := Result + #13#10;
J := 0;
end;
end;
end; { QuotedPrintableEncode }
function QuotedPrintableDecode(mCode: string): string;
var
I, J, L: Integer;
begin
Result := '';
J := 0;
L := Length(mCode);
I := 1;
while I <= L do begin
if mCode[I] = '=' then begin
Result := Result + Chr(StrToIntDef('%ITEM_CONTENT%apos; + Copy(mCode, I + 1, 2), 0));
Inc(J, 3);
Inc(I, 3);
end else if mCode[I] in [#13, #10] then begin
if J < 72 then Result := Result + mCode[I];
if mCode[I] = #10 then J := 0;
Inc(I);
end else begin
Result := Result + mCode[I];
Inc(J);
Inc(I);
end;
end;
end; { QuotedPrintableDecode }
const
cScaleChar = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
function IntToDigit(mNumber: Integer; mScale: Byte; mLength: Integer = 0): string;
var
I, J: Integer;
begin
Result := '';
I := mNumber;
while (I >= mScale) and (mScale > 1) do begin
J := I mod mScale;
I := I div mScale;
Result := cScaleChar[J + 1] + Result;
end;
Result := cScaleChar[I + 1] + Result;
if mLength > 0 then
for I := 1 to mLength - Length(Result) do
Result := '0' + Result;
end; { IntToDigit }
function DigitToInt(mDigit: string; mScale: Byte): Integer;
var
I: Byte;
L: Integer;
begin
Result := 0;
L := Length(mDigit);
for I := 1 to L do
Result := Result + (Pos(mDigit[L - I + 1], cScaleChar) - 1) *
Trunc(IntPower(mScale, I - 1));
end; { DigitToInt }
const
cBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Base64Encode(mSource: string; mAddLine: Boolean = True): string;
var
I, J: Integer;
S: string;
T: string;
begin
Result := '';
J := 0;
for I := 0 to Length(mSource) div 3 - 1 do begin
S := Copy(mSource, I * 3 + 1, 3);
T := IntToDigit(Ord(S[1]), 2, 8) + IntToDigit(Ord(S[2]), 2, 8) + IntToDigit(Ord(S[3]), 2, 8);
Result := Result + cBase64[DigitToInt(Copy(T, 01, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 07, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 13, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 19, 6), 2) + 1];
if mAddLine then begin
Inc(J, 4);
if J >= 76 then begin
Result := Result + #13#10;
J := 0;
end;
end;
end;
I := Length(mSource) div 3;
S := Copy(mSource, I * 3 + 1, 3);
case Length(S) of
1: begin
T := IntToDigit(Ord(S[1]), 2, 8) + '0000';
Result := Result + cBase64[DigitToInt(Copy(T, 01, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 07, 6), 2) + 1];
Result := Result + '=';
Result := Result + '=';
end;
2: begin
T := IntToDigit(Ord(S[1]), 2, 8) + IntToDigit(Ord(S[2]), 2, 8) + '0000';
Result := Result + cBase64[DigitToInt(Copy(T, 01, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 07, 6), 2) + 1];
Result := Result + cBase64[DigitToInt(Copy(T, 13, 6), 2) + 1];
Result := Result + '=';
end;
end;
end;
function StringToSysCharSet(mStr: string): TSysCharSet;
var
I: Integer;
begin
Result := [];
for I := 1 to Length(mStr) do
Include(Result, mStr[I]);
end; { StringToSysCharSet }
function Base64Decode(mCode: string): string;
var
I, L: Integer;
S: string;
T: string;
begin
Result := '';
L := Length(mCode);
I := 1;
while I <= L do begin
if Pos(mCode[I], cBase64) > 0 then begin
S := Copy(mCode, I, 4);
if (Length(S) = 4) then begin
T := IntToDigit(Pos(S[1], cBase64) - 1, 2, 6) +
IntToDigit(Pos(S[2], cBase64) - 1, 2, 6) +
IntToDigit(Pos(S[3], cBase64) - 1, 2, 6) +
IntToDigit(Pos(S[4], cBase64) - 1, 2, 6);
Result := Result + Chr(DigitToInt(Copy(T, 01, 8), 2));
if S[3] <> '=' then begin
Result := Result + Chr(DigitToInt(Copy(T, 09, 8), 2));
if S[4] <> '=' then
Result := Result + Chr(DigitToInt(Copy(T, 17, 8), 2));
end;
end;
Inc(I, 4);
end else Inc(I);
end;
end; { Base64Decode }
回复人： zswang(伴水)(被黑中) (2001-12-12 22:50:52) 得0分
//再建议收录
http://www.csdn.net/expert/topic/384/384138.shtm
const
cCharCn: array[#32 .. #126] of string[2] =
(
{ }' ',{!}'！',{"}'＂',{#}'＃',{ }'＄',{%}'％',{&}'＆',{'}'＇',{(}'（',
{)}'）',{*}'＊',{+}'＋',{,}'，',{-}'－',{.}'。',{/}'／',{0}'０',{1}'１',
{2}'２',{3}'３',{4}'４',{5}'５',{6}'６',{7}'７',{8}'８',{9}'９',{:}'：',
{;}'；',{<}'＜',{=}'＝',{>}'＞',{?}'？',{@}'＠',{A}'Ａ',{B}'Ｂ',{C}'Ｃ',
{D}'Ｄ',{E}'Ｅ',{F}'Ｆ',{G}'Ｇ',{H}'Ｈ',{I}'Ｉ',{J}'Ｊ',{K}'Ｋ',{L}'Ｌ',
{M}'Ｍ',{N}'Ｎ',{O}'Ｏ',{P}'Ｐ',{Q}'Ｑ',{R}'Ｒ',{S}'Ｓ',{T}'Ｔ',{U}'Ｕ',
{V}'Ｖ',{W}'Ｗ',{X}'Ｘ',{Y}'Ｙ',{Z}'Ｚ',{[}'［',{\}'＼',{]}'］',{^}'＾',
{_}'＿',{`}'｀',{a}'ａ',{b}'ｂ',{c}'ｃ',{d}'ｄ',{e}'ｅ',{f}'ｆ',{g}'ｇ',
{h}'ｈ',{i}'ｉ',{j}'ｊ',{k}'ｋ',{l}'ｌ',{m}'ｍ',{n}'ｎ',{o}'ｏ',{p}'ｐ',
{q}'ｑ',{r}'ｒ',{s}'ｓ',{t}'ｔ',{u}'ｕ',{v}'ｖ',{w}'ｗ',{x}'ｘ',{y}'ｙ',
{z}'ｚ',{{}'｛',{|}'｜',{ }'｝',{~}'～');
回复人： zswang(伴水)(被黑中) (2001-12-12 22:59:12) 得0分
//加上面的常量试试看
function CharToCharCn(mChar: Char): string;
begin
case mChar of
#32 .. #126: Result := cCharCn[mChar];
else Result := mChar;
end;
end; { CharToCharCn }
function CharCnToChar(mCharCn: string): Char;
var
I: Char;
begin
Result := #0;
for I := #32 to #126 do
if cCharCn[I] = mCharCn then begin
Result := I;
Break;
end;
end; { CharCnToChar }
function StrToStrCn(mStr: string): string;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mStr) do
Result := Result + CharToCharCn(mStr[I]);
end; { StrToStrCn }
function StrCnToStr(mText: string): string;
var
I: Integer;
Temp: string;
C: Char;
begin
Result := '';
Temp := '';
for I := 1 to Length(mText) do
case ByteType(mText, I) of
mbSingleByte: Result := Result + mText[I];
mbLeadByte: Temp := Temp + mText[I];
mbTrailByte: begin
Temp := Temp + mText[I];
C := CharCnToChar(Temp);
if C <> #0 then
Result := Result + C
else Result := Result + Temp;
Temp := '';
end;
end;
Result := Result + Temp;
end; { StrCnToStr }
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := StrToStrCn(Memo2.Text)
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo2.Text := StrCnToStr(Memo1.Text)
end;