用VFP实现一个网盘软件,上传,下载,删除一个不少

2023-01-03 16:42:25 浏览数 (1)

开发环境 VFP9 SP2 7423 祺佑三层开发框架(猫框)

1. 实现后端的文件管理WebAPI

WebApi的默认管理路径为网站的根目录

代码语言:javascript复制
Define Class ctl_folder As Session
  *--获取所有目录
  Procedure  getlist
    Do setenv
    *--默认为wwwroot目录
    Local cPath,cfolder
    cfolder=HttpQueryParams2("folder")
    cPath=getwwwrootpath()

    If !Empty(cfolder)
      cPath=Addbs(cPath) cfolder
    Endif

    If !Directory(cPath)
      Error "目录不存在"
    Endif

    cPath=Addbs(cPath) "*.*"

    oJson=Createobject("foxjson",{})

    Adir(larray,cPath,"D")
    For lni =1 To Alen(larray,1)

      oRow=Createobject("foxjson")
      oRow.Append("文件名",larray(lni ,1))
      oRow.Append("文件大小",Ceiling(larray(lni ,2)/1024))
      oRow.Append("修改时间",Transform(larray(lni ,3)) "T" larray(lni ,4))
      If At("D",larray(lni ,5))>0
        oRow.Append("类型","目录")
      Else
        oRow.Append("类型",Justext(larray(lni ,1)))
      Endif
      oJson.Append(oRow)
    Endfor

    oReturn=Createobject("foxjson")
    oReturn.Append("folder",cfolder)
    oReturn.Append("rows",oJson)
    Return oReturn.tostring()
  Endproc
    *--上传文件
  Procedure  upfile
    Local oResult
    oResult=GetUpfile(This.iconnid)
    Local cPath,cFloder
    cfolder=HttpQueryParams2("folder")
    cPath=getwwwrootpath()

    If !Empty(cfolder)
      cPath=Addbs(cPath) cfolder
    Endif

    If !Directory(cPath)
      Error "目录不存在"
    Endif

    *--返回为对象
    cFilename=oResult.ofieldcoll.Item("fileData").filename
    cMydata=oResult.ofieldcoll.Item("fileData").fielddata
    Strtofile(cMydata,Addbs(cPath) cFilename)

    TEXT TO lcResult NOSHOW TEXTMERGE PRETEXT 1 2
      {"errno":0,"errmsg":"ok","errorMsg":"ok","success":true,"file1":"<<cFilename>>"}
    ENDTEXT
    Return  lcResult

  Endproc

    *-- 删除目录或文件
  Procedure  del
    Local cPath,cfolder,caction,ctype
    cfolder=HttpQueryParams2("folder")
    caction=HttpQueryParams2("action")
    ctype=HttpQueryParams2("type")

    cPath=getwwwrootpath()

    If !Empty(cfolder)
      cPath=Addbs(cPath) cfolder
    Endif
    If Empty(caction)
      Error "操作对象不存在"
    Endif
    cPath=Addbs(cPath) caction

    If ctype=="目录"
      If !Directory(cPath)
        Error "目录不存在"
      Endif
    Else
      If !File(cPath)
        Error "文件不存在"
      Endif
    Endif

    If !DeleteFiles(cPath,.T.)
      Error "删除失败"
    Endif

    Return [{"errno":0,"errmsg":"ok"}]
  Endproc

    *-- 创建目录
  Procedure Mkdir
    Local cPath,cfolder,caction,ctype
    cfolder=HttpQueryParams2("folder")
    caction=HttpQueryParams2("action")
    cPath=getwwwrootpath()

    If !Empty(cfolder)
      cPath=Addbs(cPath) cfolder
    Endif
    If Empty(caction)
      Error "操作对象不存在"
    Endif
    cPath=Addbs(cPath) caction
    Mkdir cPath
    Return [{"errno":0,"errmsg":"ok"}]
  Endproc
Enddefine

2. 前端管理软件开发

这里是用VFP来实现的,实际上用网页、微信小程序、APP都是OK的。

代码解析

获取所有文件夹与文件代码

表单getlist方法

代码语言:javascript复制
Lparameters IsLoad,isnew,cfolder

cUrl=serverurl "ctl_folder.fsp?proc=getlist"
cSenddata="folder=" cfolder

Qiyu_HttpClient =Newobject("Qiyu_HttpClient","Qiyu_HttpClient.prg")
Qiyu_HttpClient.method="post"
cReturn= Qiyu_HttpClient.Send(cUrl,cSenddata)
If Isnull(cReturn)
  Messagebox(Qiyu_HttpClient.msg)
  Return .F.
Endif

*--还要判断errno
If !IsLoad
  Thisform.qiyu_GRID_SORT1.RecordSource=.Null.
Endif

oReturn=foxjson_parse(cReturn)
If oReturn.getkey("errno")>0 AND oReturn.Item("errno")!=0
  Messagebox(oReturn.Item("errmsg"))
  RETURN .f.
Endif

thisform.webpath=oReturn.item("folder")

oReader=Newobject("QiyuJsonReader","QiyuJsonReader.prg") &&JSON序列类
TEXT TO oReader.cursorstruct NOSHOW TEXTMERGE
文件名 C(254),修改时间 T,文件大小 i,类型 c(10)
ENDTEXT
oReader.Alias="myorder"  &&临时表名
*oReader.keylist="id"
oReader.root="rows"  &&JSON数组所在位置 目前只支持第一层
If oReader.parsecursor(cReturn,0)<0 &&0 自动  1 新增  2 编辑 3 删除
  Messagebox(oReader.msg)
  Return .F.
Endif

SELECT * FROM myorder  ORDER BY 类型 DESC INTO CURSOR myorder readwrite

If !IsLoad
  Thisform.qiyu_GRID_SORT1.RecordSource="myorder"
  Thisform.qiyu_GRID_SORT1.bind()
Endif

Thisform.Refresh()

cmdupile的click事件文件上传代码:

代码语言:javascript复制
cFile=Getfile()
If !File(cFile)
  Return
Endif
cUrl=serverurl "ctl_folder.fsp?proc=upfile"
cUrl = cUrl   "&folder=" Thisform.webpath

oQiyuUploadFile =Newobject("QiyuUploadFile","QiyuUploadFile.prg")
oQiyuUploadFile.Name="fileData"
cReturn=oQiyuUploadFile.uploadfile(cUrl,cFile)
nSize=oQiyuUploadFile.filesize/1024

If Isnull(cReturn)
  Messagebox(oQiyuUploadFile.msg)
  Return
Endif

oReturn=foxjson_parse(cReturn)
If oReturn.Item("errno")!=0
  Messagebox(oReturn.Item("errmsg"))
  Return
Endif
Delete From myorder Where 文件名=Justfname(cFile)
Insert Into myorder Values(Justfname(cFile),Datetime(),nSize,Justext(cFile))
Go Bottom
Thisform.Refresh()

cmddownload 的click事件下载文件代码

代码语言:javascript复制
Select myorder
lcfile=myorder.文件名
If Alltrim(myorder.类型)!="目录"
  cUrl=serverurl Strtran(Addbs(Thisform.webpath),"","/") Alltrim(lcfile)
  cFilename=Putfile("保存",Ttoc(Datetime(),1),Justext(lcfile))  
  If !Empty(cFilename)
    Qiyu_HttpClient =Newobject("Qiyu_HttpClient","Qiyu_HttpClient.prg")
    Qiyu_HttpClient.setHeader("content-type","application/json")    &&  content-type 默认为 application/json
    Qiyu_HttpClient.method="GET"   &&GET  POST HTTP 请求方法
    Qiyu_HttpClient.DataType="BIN"    &&数据类型 string 字符串  bin 二进制流  
    cReturn= Qiyu_HttpClient.Send(cUrl)
    If Isnull(cReturn)
      Messagebox(Qiyu_HttpClient.msg)
    Else
      Strtofile(cReturn,cFilename)
    Endif
  Endif
Endif

cmddel的click事件 删除文件或文件夹代码

代码语言:javascript复制
yn=MESSAGEBOX("您确认要删除文件吗",4 32,thisform.Caption)
IF yn<>6
 RETURN 
ENDIF 

cUrl=serverurl "ctl_folder.fsp?proc=del"
cUrl = cUrl   "&folder=" Thisform.webpath
cUrl=cUrl "&action=" Alltrim(文件名) "&type=" Alltrim(类型)

Qiyu_HttpClient =Newobject("Qiyu_HttpClient","Qiyu_HttpClient.prg")
Qiyu_HttpClient.setHeader("content-type","application/json")    &&  content-type 默认为 application/json
Qiyu_HttpClient.method="GET"   &&GET  POST HTTP 请求方法
Qiyu_HttpClient.DataType="STRING"    &&数据类型 string 字符串  bin 二进制流

cReturn= Qiyu_HttpClient.Send(cUrl)
If Isnull(cReturn)
  Messagebox(Qiyu_HttpClient.msg)
  Return
Endif


oReturn=foxjson_parse(cReturn)
If oReturn.Item("errno")!=0
  Messagebox(oReturn.Item("errmsg"))
  Return
Endif

Delete In myorder
SKIP In myorder
Skip -1 In myorder
Thisform.qiyu_grid_sort1.Refresh()
Thisform.qiyu_grid_sort1.AfterRowColChange()

表格的column1.text1 的dblclick事件

代码语言:javascript复制
Local lcdir
lcdir=""
If Alltrim(类型)=="目录"  
  Do Case
    Case  Alltrim(文件名)=="."  &&刷新当前目录
      lcdir=Thisform.webpath

    Case Alltrim(文件名)==".."  &&进入上层目录
      Alines(ladir,Thisform.webpath,"")
      lcpath=""
      For lni=1 To Alen(ladir)-1
        lcpath = lcpath   "" ladir(lni)
      Endfor

      Thisform.getlist(.F.,.T.,lcpath)
      lcdir=lcpath

    Otherwise
      lcdir=Addbs(Thisform.webpath) Alltrim(文件名)
  Endcase

  If Thisform.getlist(.F.,.T.,lcdir)
    Thisform.collfloder.Add(lcdir)  
  Endif
Endif

0 人点赞