精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● VFP>>〖源码共赏〗>>在论坛发布文件的工具(PRG版,源代码)

主题:在论坛发布文件的工具(PRG版,源代码)
发信人: 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]           

[关闭][返回]