谁可以帮我将这asp代码转来delphi代码 ( 积分: 50 )

  • 主题发起人 主题发起人 无厘头
  • 开始时间 开始时间

无厘头

Unregistered / Unconfirmed
GUEST, unregistred user!
<%
'********************************************************************************
'* *
'* CFS Encode Function *
'* *
'* Produced by ASP-Zone *
'* *
'* Main website is located at *
'* http://asp.diy.com.tw/ *
'* *
'* E-MAIL: *
'* thiefghost@games.com.tw *
'* *
'* Use this function: *
'* <!--#include file="Codefun.fun" --> *
'* *
'* 2001/8/3 *
'* *
'********************************************************************************

'Encode Function
Function CfsEnCode(CodeStr)

Dim CodeLen
Dim CodeSpace
Dim NewCode

CodeLen = 30
CodeSpace = CodeLen - Len(CodeStr)

If Not CodeSpace < 1 Then
For cecr = 1 To CodeSpace
CodeStr = CodeStr & Chr(21)
Next
End If

NewCode = 1

Dim Been
For cecb = 1 To CodeLen
Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb
NewCode = NewCode * Been
Next

CodeStr = NewCode
NewCode = Empty

For cec = 1 To Len(CodeStr)
NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3))
Next

For cec = 20 To Len(NewCode) - 18 Step 2
CfsEnCode = CfsEnCode & Mid(NewCode,cec,1)
Next

End Function


Function CfsCode(Word)
For cc = 1 To Len(Word)
CfsCode = CfsCode & Asc(Mid(Word,cc,1))
Next
CfsCode = Hex(CfsCode)
End Function

%>
 
<%
'********************************************************************************
'* *
'* CFS Encode Function *
'* *
'* Produced by ASP-Zone *
'* *
'* Main website is located at *
'* http://asp.diy.com.tw/ *
'* *
'* E-MAIL: *
'* thiefghost@games.com.tw *
'* *
'* Use this function: *
'* <!--#include file="Codefun.fun" --> *
'* *
'* 2001/8/3 *
'* *
'********************************************************************************

'Encode Function
Function CfsEnCode(CodeStr)

Dim CodeLen
Dim CodeSpace
Dim NewCode

CodeLen = 30
CodeSpace = CodeLen - Len(CodeStr)

If Not CodeSpace < 1 Then
For cecr = 1 To CodeSpace
CodeStr = CodeStr & Chr(21)
Next
End If

NewCode = 1

Dim Been
For cecb = 1 To CodeLen
Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb
NewCode = NewCode * Been
Next

CodeStr = NewCode
NewCode = Empty

For cec = 1 To Len(CodeStr)
NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3))
Next

For cec = 20 To Len(NewCode) - 18 Step 2
CfsEnCode = CfsEnCode & Mid(NewCode,cec,1)
Next

End Function


Function CfsCode(Word)
For cc = 1 To Len(Word)
CfsCode = CfsCode & Asc(Mid(Word,cc,1))
Next
CfsCode = Hex(CfsCode)
End Function

%>
 
还有这个文件要贴出来 Codefun.fun
 
上面的内容就是Codefun.fun 文件的内容呀,上面的注释是说怎么引用它而已
 
Function TForm1.CfsCode(Word: string): string;
var
b:byte;
cc : integer;
TempR : string;
aa : char;
begin
Result := '';
For cc := 1 To Length(Word) do
begin
aa := Word[cc];
TempR := TempR + inttostr(byte(aa)); //Asc
end ;
TempR := inttohex(strtoint(TempR),2); //1356
Result := TempR;
end;


Function TForm1.CfsEnCode( CodeStr : string) :string ;
var
CodeLen,CodeSpace,NewCode : integer;
cecr,cecb ,cec,Been:integer;
tempchar : char;
tNewCode : string;
begin

CodeLen := 30;
CodeSpace := CodeLen - Length(CodeStr);

If Not CodeSpace < 1 Then
begin
For cecr := 1 To CodeSpace do
begin
CodeStr := CodeStr + char(21);
End;
end;
NewCode := 1;

For cecb := 1 To CodeLen do
begin
tempchar := CodeStr[cecb];
Been := CodeLen + byte(tempchar) * cecb;
NewCode := NewCode * Been;
end;

CodeStr := inttostr(NewCode);
tNewCode := '';

For cec := 1 To Length(CodeStr) do
begin
tNewCode := tNewCode + CfsCode(Copy(CodeStr,cec,3));
end;

Result := '';
For cec := 20 To Length(tNewCode) - 18 do
begin
if cec mod 2 = 1 then Break;
Result := Result + Copy(tNewCode,cec,1) ;
end;
end;


帮看看我的为问题;
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2995946
 
Function CfsEnCode(CodeStr : string) :string;
Function CfsCode(Word: string):string;
 
if cec mod 2 = 1 then continue ; 修改一下
 
谢谢fanronghua
网页代码怕我帮不上你了,我对这代码了解不多,不过分就给你了
 
后退
顶部