发信人: hunter__fox(雁回西楼)
整理人: foxzz(2003-06-22 13:56:28), 站内信件
|
以下代码是一个可运行的表单，利用它，我们能将我们机器上的各种文件，如，表格，类库，甚至DLL和EXE都可以发布到论坛上来。
具体的做法是，我们将每一个字节的内容转换成为一个两位的十六进制数，这样，内容就全部变成了"0123456789ABCDEF"的组合了。
生成的目标文件是原来文件的2倍大小。适合发布一些不大的文件，如，一些很小的示范工程，一个类库，或者一个小图片之类。
一般情况下，不建议朋友们使用它互相传递大文件。
下面的代码完整复制，保存为一个Prg，即可运行它了。此代码没有进行容错处理，一些操作可能会提示错误，请使用中不要对包含非十六进制数的文件进行"转为文件"操作。
Public frmTextTool
frmTextTool = CreateObject("_Form")
frmTextTool.Show
Release frmTextTool
&&--------------------------------------------------------------------------
&&此工具的表单类
&&--------------------------------------------------------------------------
Define Class _Form As Form
Caption = "论坛发布转换工具"
Height = 260
Width = 300
WindowType = 1
Add Object Edit1 As _Edit With Top=0,Left=0,Width=300,Height=240
Add Object cmdOpen As CommandButton With Top=242,Height=17,Width=50,Left=0,Caption="打开(\<O)"
Add Object cmdSave As CommandButton With Top=242,Height=17,Width=60,Left=50,Caption="另存为(\<S)"
Add Object cmdToStr As CommandButton With Top=242,Height=17,Width=70,Left=110,Caption="转为文字(\<T)"
Add Object cmdToBit As CommandButton With Top=242,Height=17,Width=70,Left=180,Caption="转为文件(\<F)"
Add Object cmdExit As CommandButton With Top=242,Height=17,Width=50,Left=250,Caption="退出(\<E)"
Procedure Resize&& 窗口大小改变时
If ThisForm.Height < 200
ThisForm.Height = 200
EndIf
If ThisForm.Width < 300
ThisForm.Width = 300
EndIf
With ThisForm
.Edit1.Width = .Width
.Edit1.Height = .Height - 20
.cmdOpen.Top = .Height - 18
.cmdSave.Top = .Height - 18
.cmdToStr.Top = .Height - 18
.cmdToBit.Top = .Height - 18
.cmdExit.Top = .Height - 18
EndWith
EndProc
Procedure cmdOpen.Click&& 打开文件
Local cFileName
Local nFileHandle
Local nSize
cFileName = GetFile()
If File(cFileName)
nFileHandle = FOpen(cFileName)
nSize = FSeek(nFileHandle,0,2)
If nSize <= 0
MessageBox("文件不存在或者没有内容")
Return
EndIf
FSeek(nFileHandle,0,0)
ThisForm.Edit1.Value = FRead(nFileHandle,nSize)
FClose(nFileHandle)
ThisForm.Edit1.SetFocus
EndIf
EndProc
Procedure cmdSave.Click&& 文件保存为
Local cFileName
Local nFileHandle
Local nSize
cFileName = Getfile()
If File(cFileName)
If MessageBox("文件已经存在，是否改写它？",4) = 7
Return
EndIf
EndIf
nSize = Len(ThisForm.Edit1.Value)
nFileHandle = FCreat(cFileName)
FSeek(nFileHandle,0,0)
FWrite(nFileHandle,ThisForm.Edit1.Value)
FClose(nFileHandle)
EndProc
Procedure cmdToStr.Click&& 转换为可发表的字串
ThisForm.Edit1.ToStr
ThisForm.Edit1.SetFocus
EndProc
Procedure cmdToBit.Click&& 转换为可使用的文件
ThisForm.Edit1.ToBit
ThisForm.Edit1.SetFocus
EndProc
Procedure cmdExit.Click&& 关闭此工具
ThisForm.Release
EndProc
EndDefine
&&--------------------------------------------------------------------------
&&具有字串转换功能的Edit
&&--------------------------------------------------------------------------
Define Class _Edit As EditBox
Procedure ToStr
This.Value = This.BitToText(This.Value)
EndProc
Procedure ToBit
This.Value = This.TextToBit(This.Value)
EndProc
Function BitToText(cText)&& 转换为可发表字串的具体代码
Local nTextLen
Local cNowByte
Local cNowASC
Local cReturn
Local n
Local TextList(16)
TextList(1) = "0"
TextList(2) = "1"
TextList(3) = "2"
TextList(4) = "3"
TextList(5) = "4"
TextList(6) = "5"
TextList(7) = "6"
TextList(8) = "7"
TextList(9) = "8"
TextList(10) = "9"
TextList(11) = "A"
TextList(12) = "B"
TextList(13) = "C"
TextList(14) = "D"
TextList(15) = "E"
TextList(16) = "F"
If (Len(Alltrim(cText))) = 0
Return ""
EndIf
cReturn = ""
nTextLen = Len(cText)
cNowASC = ""
For n = 1 To nTextLen
cNowByte = Asc(Substr(cText,n,1))
cNowASC = TextList(Int(cNowByte/16) + 1)
cNowASC = cNowASC + TextList(Mod(cNowByte,16) + 1)
cReturn = cReturn + cNowASC && + " "
EndFor
Return cReturn
EndFunc
Function TextToBit(cASCII)&& 转换为可使用文件的具体代码
Local cReturn
Local cNowASC
Local n
If Len(Alltrim(cASCII)) = 0
Return ""
EndIf
cReturn = ""
cASCII = StrTran(cASCII," ")
cASCII = StrTran(cASCII,Chr(13) + Chr(10))
For n = 1 To Len(cASCII) Step 2
cNowASC = "0x" + Substr(cASCII,n,2)
cReturn = cReturn + chr(&cNowASC)
EndFor
Return cReturn
EndFunc
Procedure Error
LParameters nError, cMethod, nLine
Return
EndProc
EndDefine
----
作者：hunter__fox【雁回西楼】
※ 来源: 网易虚拟社区 广州站．
※ 个人天地 流水情怀[ccbyy] 灌水精英 NO:003
※ 编程开发 VFP[VFP] |
|