私人图片储存系统源码_Cocos Creator怎么使用安卓手机相册中的图片最好有示例源码

㈠ VB 修改图片的尺寸并保存，比如现有图片256*128，我要修改成15*15的尺寸，要源码！

首先，声明以下核心代码部分完全照抄，由CSDN上laviewpbt提供，我在之前一篇VB常见问题里给出过链接。当时提到VB的效率问题，我举
出图片缩放的例子，用VB写的图片缩放，效率居然很高，以此证明算法的重要性。laviewpbt又是受到了CSDN上zyl910，本名好像叫周岳灵的
激发，结果做出的程序效率更加惊人。有兴趣的可以看看我这篇文章里给出的论坛链接。
所以，我这里用的解决方法就是从他们这里得来。不过这些高人们关注的是效率，程序里面有很大篇幅是不同算法比较，已经时间测试。而对于更加关心使用的人来说，代码需要裁剪。我粗略的筛选了下，对模块内容没有改动，而只是从主程序里拨出我们需要的内容。
那么，就开始吧。
首先，用到三个模块和一个类模块，这部分代码我们不用重写了。程序搭建时候添加进去。需要说明的是，如果你已经有一个在做的项目，那么简单的导入模块可能是不行的。laviewpbt给我们做了一个很好的示范，他的API声明都是在一个模块里面的，那么你的项目最好也这样，然后，把他的API声明贴在后面，运行程序时候如果有重复，会自动找到，然后你就停掉他，注释掉或者删除。这几个模块的内容我最后贴出，这里到现在也不能上传附件。
那么，我们重点要介绍怎么用。
Private DIBData As CImagePrivate DIBWork As CImage
首先要声明两个类变量。这个是我们自定义的类。在模块里。
接着两段代码，一个加载图片，一个改变图片大小。
我们要打开图片，初始化上面这两个量，初始化过程写在 form_load里面
Set DIBData = New CImage
Set DIBWork = New CImage
scaNum = 1 '这个是比例
scaWidth = Me.Width '这个是窗体宽度的初始参照值
Picture1.Picture = LoadPicture(App.Path & "\手球场地小图.jpg")
Dim DIBTemp As New CImage
If DIBTemp.LoadPictureFromFile(App.Path & "\手球场地小图.jpg") = True Then
Set DIBData = DIBTemp
DIBWork.DisposeResource

Picture1.Width = DIBData.Width
Picture1.Height = DIBData.Height
DIBData.Render Picture1.Hdc
Picture1.Refresh
Else
MsgBox "错误的图像文件", vbCritical
End If
Set DIBTemp = Nothing

当窗体大小变化的时候，我们再写一段代码改变图片大小已经PictureBox大小任务就完成了。
需要说明的是，以下调用的代码，对尺寸的计量单位是pixel，而VB窗体默认的计量单位是Tiwp，显示器上一个pixel里面可以有很多twip，如果你做出来的程序，图像顺畅显示了，但是就是很小，那么，恭喜你，你成功了，只是需要将尺寸转换成vb里面的tiwp，
乘以 Screen.TwipsPerPixelX
这段代码如下：
Dim W As Long, H As Long
W = DIBData.Width * scaNum
H = DIBData.Height * scaNum
If W < 1 Then W = 1 If H < 1 Then H = 1
Dim DIBTemp As New CImage
Dim t As Currency
Me.MousePointer = vbHourglass
t = Utility.GetCurrentTime
Set DIBTemp = Resample(DIBData, W, H, 2) '这里固定选择一个算法，双线性内插值
' t = GetCurrentTime - t
Me.MousePointer = vbDefault
' Me.Caption = " 处理时间：" & Format(t / 1000, "##,###,##0.000") & "秒"
Set DIBWork = DIBTemp
Set DIBTemp = Nothing
PicData.Width = DIBWork.Width * Screen.TwipsPerPixelX
PicData.Height = DIBWork.Height * Screen.TwipsPerPixelX
DIBWork.Render PicData.Hdc
' SolNum
PicData.Refresh
代码被我注释掉一部分，原代码中有时间测试内容。
把这段代码独立成一个Sub，然后在form_reSize里面调用，当然，调用之前首先要计算变化比例scaNum

下面开贴模块代码
模块一、ImageResize模块：
Option Explicit
Public Enum ResizeModeConst
SMC_Nearest = 0 '最邻近插值
SMC_StretchBlt = 1 'StretchBlt
SMC_BiliNear = 2 '双线性内插值
End Enum

Public
Function Resample(Img As CImage, NewWidth As Long, NewHeight As Long,
Optional Method As ResizeModeConst = SMC_BiliNear) As CImage
Dim X As Long, Y As Long
Dim XX As Long, YY As Long
Dim OldYY As Long
Dim Width As Long, Height As Long
Dim Sa As SAFEARRAY, SaN As SAFEARRAY
Dim ImageData() As Byte, NewImageData() As Byte
Dim Stride As Long, NewStride As Long
Dim Offset As Long

Dim Speed As Long, SpeedN As Long
Dim NewImg As New CImage
If NewImg.CreateNewImage(NewWidth, NewHeight) = True Then

With Sa
.Element = 1
.Dimension = 1
.Bounds.Elements = Img.Stride * Img.Height
.Pointer = Img.Pointer
End With
CopyMemory ByVal VarPtrArray(ImageData()), VarPtr(Sa), 4

With SaN
.Element = 1
.Dimension = 1
.Bounds.Elements = NewImg.Stride * NewImg.Height
.Pointer = NewImg.Pointer
End With
CopyMemory ByVal VarPtrArray(NewImageData()), VarPtr(SaN), 4

Width = Img.Width: Height = Img.Height
Stride = Img.Stride: NewStride = NewImg.Stride

ReDim LinearRow(NewWidth - 1) As Long

Select Case Method

Case ResizeModeConst.SMC_Nearest

OldYY = -1
For X = 0 To NewWidth - 1
LinearRow(X) = (X * Width \ NewWidth) * 3
Next
For Y = 0 To NewHeight - 1
SpeedN = Y * NewStride
YY = Y * Height \ NewHeight
Offset = YY * Stride
If YY = OldYY Then
CopyMemory NewImageData(SpeedN), NewImageData(SpeedN - NewStride), NewStride
Else
OldYY = YY
For X = 0 To NewWidth - 1
Speed = Offset + LinearRow(X)
NewImageData(SpeedN) = ImageData(Speed)
NewImageData(SpeedN + 1) = ImageData(Speed + 1)
NewImageData(SpeedN + 2) = ImageData(Speed + 2)
SpeedN = SpeedN + 3
Next
End If
Next

Case ResizeModeConst.SMC_StretchBlt
Img.Render NewImg.Hdc, 0, 0, NewImg.Width, NewImg.Height, 0, 0, Img.Width, Img.Height

Case ResizeModeConst.SMC_BiliNear
Dim PartXX As Long, PartYY As Long
Dim InvertXX As Long, InvertYY As Long
Dim NewX As Long, NewY As Long
Dim SpeedP As Long, ColOffset As Long
Dim Pos As Double
ReDim RowOffset(NewWidth - 1) As Long
ReDim RowPartXX(NewWidth - 1) As Long
For X = 0 To NewWidth - 1
Pos = X * (Width - 1) / NewWidth
RowOffset(X) = Int(Pos) * 3
RowPartXX(X) = (Pos - Int(Pos)) * 2048
Next

For Y = 0 To NewHeight - 1
SpeedN = Y * NewStride
Pos = Y * (Height - 1) / NewHeight
PartYY = (Pos - Int(Pos)) * 2048
InvertYY = 2048 - PartYY
ColOffset = Int(Pos) * Stride
For X = 0 To NewWidth - 1
PartXX = RowPartXX(X)
InvertXX = 2048 - PartXX
Speed = ColOffset + RowOffset(X)
SpeedP = Speed + Stride

NewImageData(SpeedN + 2) = ((ImageData(Speed + 2) * InvertXX +
ImageData(Speed + 5) * PartXX) * InvertYY + (ImageData(SpeedP + 2) *
InvertXX + ImageData(SpeedP + 5) * PartXX) * PartYY) \ 4194304

NewImageData(SpeedN + 1) = ((ImageData(Speed + 1) * InvertXX +
ImageData(Speed + 4) * PartXX) * InvertYY + (ImageData(SpeedP + 1) *
InvertXX + ImageData(SpeedP + 4) * PartXX) * PartYY) \ 4194304

NewImageData(SpeedN) = ((ImageData(Speed) * InvertXX + ImageData(Speed +
3) * PartXX) * InvertYY + (ImageData(SpeedP) * InvertXX +
ImageData(SpeedP + 3) * PartXX) * PartYY) \ 4194304
SpeedN = SpeedN + 3
Next
Next

End Select

CopyMemory ByVal VarPtrArray(ImageData()), 0&, 4
CopyMemory ByVal VarPtrArray(NewImageData()), 0&, 4
End If
Set Resample = NewImg
End Function

模块2、可以忽略的和时间测试有关部分，内容不多，也贴出
Private SystemFrequency As Currency
Public Function GetCurrentTime() As Currency
If SystemFrequency = 0 Then '未初始化
If QueryPerformanceFrequency(SystemFrequency) = 0 Then
SystemFrequency = ERRORINDEX '无高精度计数器
End If
End If
If SystemFrequency <> ERRORINDEX Then
Dim CurCount As Currency
QueryPerformanceCounter CurCount
GetCurrentTime = CurCount * 1000@ / SystemFrequency
Else
GetCurrentTime = GetTickCount()
End If
End Function

模块3、API声明部分，需要你自己解决冲突问题。
Option Explicit
Public Const ERRORINDEX As Long = -1
Public Const DIB_RGB_COLORS As Long = 0
Public Const BI_RGB As Long = 0 '正常
Public Const STRETCH_ANDSCANS As Long = 1
Public Const STRETCH_DELETESCANS As Long = 3
Public Const STRETCH_HALFTONE As Long = 4
Public Const STRETCH_ORSCANS As Long = 2
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type RGBQUAD
Blue As Byte
Green As Byte
Red As Byte
Alpha As Byte
End Type
Public Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As RGBQUAD
End Type
Public Type SAFEARRAYBOUND
Elements As Long
lLbound As Long
End Type
Public Type SAFEARRAY2D
Dimension As Integer
Features As Integer
Element As Long
Locks As Long
Pointer As Long
Bounds(1) As SAFEARRAYBOUND
End Type
Public Type SAFEARRAY
Dimension As Integer
Features As Integer
Element As Long
Locks As Long
Pointer As Long
Bounds As SAFEARRAYBOUND
End Type
Public Type BITMAPINFOHEADER
Size As Long
Width As Long
Height As Long
Planes As Integer
BitCount As Integer
Compression As Long
SizeImage As Long
XPelsPerMeter As Long
YPelsPerMeter As Long
ClrUsed As Long
ClrImportant As Long
End Type
Public Type BITMAPINFO
Header As BITMAPINFOHEADER
Palette(255) As RGBQUAD
End Type
Public Type Bitmap
Type As Long
Width As Long
Height As Long
WidthBytes As Long
Planes As Integer
BitsPixel As Integer
Bits As Long
End Type
'
'内存操作相关API
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)
Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, ByVal numBytes As Long)
Public
Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef
Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
'VB本体API
Public
Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal
lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As
Long
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
'GDI系统API函数
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal Hdc As Long) As Long
Public
Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal Hdc As Long,
ByRef pBitmapInfo As Any, ByVal un As Long, ByRef Pointer As Long, ByVal
Handle As Long, ByVal Dw As Long) As Long
Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal Hdc As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Public
Declare Function SetDIBColorTable Lib "gdi32" (ByVal Hdc As Long, ByVal
un1 As Long, ByVal un2 As Long, pcRGBQuad As RGBQUAD) As Long
Public
Declare Function GetDIBColorTable Lib "gdi32" (ByVal Hdc As Long, ByVal
un1 As Long, ByVal un2 As Long, pRGBQuad As RGBQUAD) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal Hdc As Long, ByVal hObject As Long) As Long
Public
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal
dwRop As Long) As Long
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal Hdc As Long, ByVal nStretchMode As Long) As Long
Public
Declare Function StretchBlt Lib "gdi32" (ByVal Hdc As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal
nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As
Long
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal Hdc
As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy
As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long,
ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal
wUsage As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
类模块、CImage；文件名CImage.cls
Option Explicit
Private m_Width As Long '层的宽度
Private m_Height As Long '层的高度
Private m_Stride As Long '层数据每个扫描行的大小
Private m_Hdc As Long '层的内存DC
Private m_Pointer As Long '层数据在内存的首地址w
Private m_Handle As Long 'DIBSection的句柄
Private m_OldHandle As Long '原始设备环境的句柄
Public Property Get Width() As Long
Width = m_Width
End Property
Public Property Get Height() As Long
Height = m_Height
End Property
Public Property Get Stride() As Long
Stride = m_Stride
End Property
Public Property Get Hdc() As Long
Hdc = m_Hdc
End Property
Public Property Get Handle() As Long
Handle = m_Handle
End Property
Public Property Get Pointer() As Long
Pointer = m_Pointer
End Property
Private Sub Class_Terminate()
DisposeResource
End Sub
Public Function CreateNewImage(ByVal Width As Long, _ ByVal Height As Long) As Boolean
Dim ScreenDC As Long, BmpInfo As BITMAPINFOHEADER
If Width <= 0 Or Height <= 0 Then Exit Function
DisposeResource '删除原始的内存资源
With BmpInfo
.BitCount = 24
.Height = -Height '为了和GDI对象的坐标系统（起点坐标在左上角），建立一个倒序的DIB
.Width = Width
.Planes = 1
.Size = 40
m_Stride = ((Width * 3 + 3) And &HFFFFFFFC)
.SizeImage = m_Stride * Height
End With
ScreenDC = GetDC(0) '得到屏幕DC
m_Hdc = CreateCompatibleDC(ScreenDC)
ReleaseDC 0, ScreenDC '释放屏幕DC
m_Handle = CreateDIBSection(m_Hdc, BmpInfo, DIB_RGB_COLORS, m_Pointer, 0, 0)
If m_Handle <> 0 Then '希望系统能够让我们成功创建DIB吧
m_OldHandle = SelectObject(m_Hdc, m_Handle)
m_Width = Width: m_Height = Height
CreateNewImage = True
End If
End Function
Public Sub DisposeResource()
If m_Hdc <> 0 Then
SelectObject m_Hdc, m_OldHandle
DeleteDC m_Hdc
DeleteObject m_Handle
m_Width = 0: m_Height = 0 '重置其他的图像相关属性
m_Handle = 0: m_OldHandle = 0
m_Pointer = 0: m_Hdc = 0
End If
End Sub
Public Function Render(ByVal DestDC As Long, _
Optional ByVal DestX As Long, _
Optional ByVal DestY As Long, _
Optional ByVal DestWidth As Long, _
Optional ByVal DestHeight As Long, _
Optional ByVal SrcX As Long, _
Optional ByVal SrcY As Long, _
Optional ByVal SrcWidth As Long, _
Optional ByVal SrcHeight As Long) As Boolean
If m_Handle = 0 Then Exit Function

If DestWidth = 0 Then DestWidth = m_Width
If DestHeight = 0 Then DestHeight = m_Height
If SrcX < 0 Then SrcX = 0 ' 源X,Y不能为负，但目的X,Y可以
If SrcY < 0 Then SrcY = 0
If SrcWidth = 0 Then
SrcWidth = m_Width
ElseIf SrcWidth < 0 Then
DestWidth = -DestWidth
SrcWidth = -SrcWidth
End If
If SrcHeight = 0 Then
SrcHeight = m_Height
ElseIf SrcHeight < 0 Then
DestHeight = -DestHeight
SrcHeight = -SrcHeight
End If
SetStretchBltMode DestDC, STRETCH_HALFTONE
StretchBlt DestDC, DestX, DestY, DestWidth, DestHeight, m_Hdc, SrcX, SrcY, SrcWidth, SrcHeight, vbSrcCopy
End Function
Public Function LoadPictureFromFile(FileName As String) As Boolean
Dim Width As Long, Height As Long
Dim StdPic As StdPicture
On Error GoTo Errhandle:
Set StdPic = LoadPicture(FileName)
Width = ConvertHimetrixToPixels(StdPic.Width, True)
Height = ConvertHimetrixToPixels(StdPic.Height, False)
If CreateNewImage(Width, Height) = True Then

StdPic.Render m_Hdc + 0&, 0&, 0&, Width + 0&, Height +
0&, 0, StdPic.Height, StdPic.Width, -StdPic.Height, ByVal 0
'类似于BMP的逆序存储，所以用-StdPic.Height
LoadPictureFromFile = True
End If
Errhandle:

End Function
Private Function ConvertHimetrixToPixels(HiMetrix As Long, Horizontally As Boolean) As Long
If Horizontally Then
ConvertHimetrixToPixels = HiMetrix * 1440 / 2540 / Screen.TwipsPerPixelX
Else
ConvertHimetrixToPixels = HiMetrix * 1440 / 2540 / Screen.TwipsPerPixelY
End If
End Function
Private Function ConvertPixelsToHimetrix(Pixels As Long, Horizontally As Boolean) As Long
If Horizontally Then
ConvertPixelsToHimetrix = Pixels * Screen.TwipsPerPixelX * 2540 / 1440
Else
ConvertPixelsToHimetrix = Pixels * Screen.TwipsPerPixelY * 2540 / 1440
End IfEnd Function

㈡求一个能上传小说和图片的网站源码

这是我用的asp的，图片存在UpImages文件下，图片文件存在数库里，别外你自添加数据连接吧；
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>写日记</title>
<% if session("user")="" then
response.write"非法操作"
response.end
end if
%>
<link href="Css.css" rel="stylesheet" type="text/css" />
<style type="text/css">

</style></head>

<body>
<table width="800" border="0" align="center" cellspacing="0">
<tr>
<th align="right" scope="col"> <span class="STYLE12">
<script language="javaScript" type="text/javascript">

var pp,mm,month;
mydate=new Date();
pp=mydate.getDay();
month=mydate.getMonth()+1;
switch(pp)
{case 0: mm="星期日";break;
case 1: mm="星期一";break;
case 2:mm="星期二";break;
case 3: mm="星期三";break;
case 4: mm="星期四" ;break;
case 5 : mm="星期五";break;
case 6 : mm="星期六";break;
}
document.write("今天是:"+mydate.getYear()+"年"+month+"月"+mydate.getDate()

+"日"+" "+mm+" ");
</script>
</span></th>
</tr>
<tr>
<th height="40" scope="col"><img src="image/top.gif" width="800" height="157" alt="书丛制作" /></th>
</tr>
<tr>
<td height="25" align="center" background="image/ph.gif">写文章</td>
</tr>
</table>
<table width="800" border="0" align="center" cellpadding="0" cellspacing="0">
<tr>
<td bgcolor="#CCFFFF"><form action="write.asp?action=Addnew" method="post" enctype="multipart/form-data" name="form1" id="form1">
<table width="800" border="0" cellspacing="0" cellpadding="0">
<tr>
<td width="138" align="right">文章标题:</td>
<td colspan="2"><label>
<input name="title" type="text" id="title" />
</label></td>
</tr>
<tr>
<td align="right"></td>
<td width="236"><label></label>
<label for="file"></label>
<input type="file" name="file" id="file" /></td>
<td width="426"> 心情状态:
<select name="select">
<option value="一般" selected="selected">一般</option>
<option value="非常愉快">非常愉快</option>
<option value="愉快">愉快</option>
<option value="不好">不好</option>
<option value="失落">失落</option>
</select></td>
</tr>
<tr>
<td align="right">文章内容：</td>
<td colspan="2"><label>
<textarea name="content" cols="80" rows="20" id="content"></textarea>
</label></td>
</tr>
<tr>
<td align="right">操作：</td>
<td colspan="2"><label>
<input type="submit" name="Submit" value="提交" />
</label></td>
</tr>
</table>
</form>
</td>
</tr>
</table>
<table width="800" border="0" align="center" cellspacing="0">
<tr>
<th height="3" scope="col"><hr size="1" /></th>
</tr>
</table>
<table width="800" border="0" align="center" cellspacing="0">
<tr>
<th align="center" scope="col"><span class="STYLE10">Copyright 2009 ? www.pttjj.com.cn All Rights Reserved.<br />
版权所有：｜技术支持：<a href="mailto:[email protected]">书丛</a> ｜渝ICP备000**0号 </span></th>
</tr>
</table>
<%
if request("action") = "Addnew" then
newline = chrB(13) & chrB(10) 'newline表示二进制的回车符
filesize = Request.TotalBytes 'filesize是表单数据大小
filedata = Request.BinaryRead(filesize) 'filedata是表单的二进制数据
divider = leftB(filedata,clng(instrb(filedata,newline))-1) 'divider是分割符
Set Rs = Server.CreateObject("ADODB.RecordSet")
Sql="Select * From word"
Rs.Open Sql,conn,3,3
Rs.addnew
k = 1
While instrb(k,filedata,divider) < instrb((instrb(k,filedata,divider)+lenb(divider)),filedata,divider)
start = instrb(k,filedata,divider) + lenb(divider) +2
endsize = instrb((instrb(k,filedata,divider) + lenb(divider)),filedata,divider) - start - 2
content = midb(filedata,start,endsize) '取文件说明部分
start_name = instrb(content,toByte("name="""))
end_name = instrb(start_name + 6,content,toByte(""""))
nametag = midb(content,start_name+6,end_name-start_name-6) '取文件说明部分中name=""中的内容，即表单元素的名称
pos1_filename = instrb(end_name,content,toByte("filename="""))
'如果是文件框，则文件说明部分应有filename=""，那么pos1_filename不等于0
If pos1_filename = 0 Then '表单中不属于文件上传的数据处理
namevalue = toStr(midb(content,end_name+5,lenb(content)-end_name-4)) '取文件内容
' 将文件说明部分的name=""中的内容与表单元素的名称进行比较，把相应的内容加入数据库

If(InStr(toStr(nametag),"file") > 0)Then 'CenterID2'为表单控件的name属性值，以下同
Rs("image") = namevalue
session("CenterID") = namevalue '用于上传文件保存时的文件名中
End If
If(InStr(toStr(nametag),"title") > 0)Then
Rs("title") = namevalue
if namevalue="" then
Response.Write "<Script>alert('请输入标题！')</Script>"
response.end
end if
End If
If(InStr(toStr(nametag),"content") > 0)Then
Rs("content") = namevalue
if namevalue="" then
Response.Write "<Script>alert('请输入内容！')</Script>"
response.end
end if
End If

If(InStr(toStr(nametag),"select") > 0)Then
Set Rs1 = Server.CreateObject("ADODB.RecordSet")
Sql="Select * From mun"
Rs1.Open Sql,conn,3,3
Rs1("mun")=namevalue
Rs1.update
Rs1.Close
Set Rs1=nothing
End If
Rs("wtime") = year(now)&"-"&month(now)&"-"&day(now)

'Response.Write (namevalue)
'Response.Write(" <br>")
else '处理文件上传部分的数据
pos2_filename = instrb(pos1_filename+10,content,toByte(""""))
fullpath = midb(content,pos1_filename+10,pos2_filename-pos1_filename-10) '从文件说明部分中取出文件路径
covername=GetFileName(toStr(fullpath))
If(fullpath <> "")Then '如果有上传的文件，执行以下代码
dim bStart ' 取二进制流文件部分开始位置
bStart = instrb(start,filedata,newline&newline)+3

dim bEnd ' 取二进制流文件部分结束位置
bEnd=inStrB(bStart+6,filedata,divider)-bStart-3

dim stm ' 定义一个 adodb.stream 源对象 stm, 用以拷贝二进制流文件部分至另一 adodb.stream fromStm
set stm=createObject("adodb.stream")
stm.type=1 ' 二进制模式
stm.mode=3 ' 指定打开模式为读写
stm.open
stm.write filedata '写入二进制流内容

dim fromStm '定义 adodb.stream 对象 fromStm, 以保存文件
set fromStm=createOBject("adodb.stream")
with fromStm
.type=1
.mode=3
.open
stm.position = bStart ' 指定 stm 对象的起始位置, 以变量 bStart 的值为起始位置
stm.To fromStm, bEnd ' 拷贝 stm 二进制流至 fromStm 对象, 长度为 bEnd 变量的长度
.saveTofile server.MapPath (covername),2' 保存文件, 如果存在相同名称, 则覆盖
.close
end with
set fromStm = nothing

stm.close
set stm = nothing
Rs("image") =covername '将文件的相对路径写入数据库中
end if
end if
k = instrb((instrb(k,filedata,divider)+lenb(divider)),filedata,divider)
Wend
Rs.update
Rs.close
set Rs = nothing
response.Redirect"mylife.asp"
end if

function toStr(Byt) '将二进制转换为字符串
toStr=""
for i=1 to lenb(byt)
blow = midb(byt,i,1)
if ascb(blow)>127 then
toStr = toStr&chr(ascw(midb(byt,i+1,1)&blow)) '
i = i+1
else
toStr = toStr&chr(ascb(blow))
end if
Next
End function

Function toByte(Str) '将字符串转换为二进制
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode <0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
Function GetFileName(imagespath)'将路径转换为时间,并使上传的文件不重名
If imagespath <> "" Then
rname=right(toStr(fullpath),len(toStr(fullpath))-InStrRev(toStr(fullpath),".")+1)'获得后缀名
GetFileName = "UpImages/" & year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&rname
Else
GetFileName =""
End If
End Function
%>

</body>
</html>

㈢ Cocos Creator怎么使用安卓手机相册中的图片，最好有示例源码

android 将drawable中的图片保存到系统相册中的原理比较简单，获取到的bitmap，然后通过的compress方法写到一个fileoutputstream中. 再通知MediaScannerService有图片文件加入就可以了.
保存图片的核心代码如下：
Bitmap bitmap= BitmapFactory.decodeResource(getResources(), R.drawable.icon);
MediaStore.Images.Media.insertImage(context.getContentResolver(), bitmap, name, "");
或者
FileOutputStream fos = openFileOutput("image", Context.MODE_PRIVATE);
bitmap.compress(Bitmap.CompressFormat.JPEG, 100, fos);
fos.flush();
fos.close();
//发送系统通知消息
context.sendBroadcast(new Intent(Intent.ACTION_MEDIA_MOUNTED, Uri.parse("file://" + Environment.getExternalStorageDirectory())))；
另一种方法是直接使用文件流读写：
InputStream is = mContext.getResources().openRawResource(PicID);
FileOutputStream fos = new FileOutputStream(LogoFilePath);
byte[] buffer = new byte[8192];
int count = 0;
while((count=is.read(buffer)) > 0)
{
fos.write(buffer, 0, count);
}
fos.close();
is.close();
这里要注意目录权限问题：在应用程序AndroidManifest.xml中的manifest节点中加入android:sharedUerId="android.uid.system"这个属性。然后放在源码环境中编译，并通过adb install 的方式进行安装。mk文件中的属性改为LOCAL_CERTIFICATE :=platform。

导航:首页 > 源码编译 > 私人图片储存系统源码

私人图片储存系统源码

与私人图片储存系统源码相关的资料