new MMS Form (New version)
unit newmmsForlibrary;interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, xpWindow, Mask, RzEdit, RzSpnEdt, StdCtrls, RzCmboBx,
ExtCtrls, xpPanel, xpBitBtn, VirtualTrees, RzButton, RzRadChk,database,
Buttons,StrUtils,dllinterface;
type
TNewMMS = class(TForm)
CancelBtn: TxpBitBtn;
RightPanel: TBackPanel;
lblTitle: TLabel;
lblSubject: TLabel;
lblType: TLabel;
edtSubject: TEdit;
RCBType: TRzComboBox;
xpWindow1: TxpWindow;
ilImages: TImageList;
imgNewMsg: TImage;
VSTreeResource: TVirtualStringTree;
RzRadioButton1: TRzRadioButton;
RzRadioButton2: TRzRadioButton;
lblSmil: TLabel;
XpBtnAdd: TxpBitBtn;
XpBtnDelete: TxpBitBtn;
ResourceAdd:TxpBitBtn;
lblSize: TLabel;
edtsize: TEdit;
ilTreeImage: TImageList;
dlgOpenAdd: TOpenDialog;
pnl1: TPanel;
procedure CancelBtnClick(Sender: TObject);
procedure XpBtnAddClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ResourceAddClick(Sender: TObject);
procedure VSTreeResourceGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure XpBtnDeleteClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure edtSubjectMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure RzRadioButton1Click(Sender: TObject);
procedure RzRadioButton2Click(Sender: TObject);
private
function getFilenameFromFullpath(s:string):string;
function getFileSize(sFileName:string):Longint;
procedure getMMSContentType();
public
totalSize:Longint;
Stringlist:TStringList;
fileLines:TStringList;
procedure RefreshTree();
procedure generateSmilFile(smilType:string);
end;
var
NewMMS: TNewMMS;
implementation
uses
mmslibrarypage;
{$R *.dfm}
//由于需要多次使用，我将它独立出来
procedure TNewMMS.RefreshTree();
begin
VSTreeResource.RootNodeCount:=Stringlist.Count;
VSTreeResource.Refresh;
end;
procedure TNewMMS.CancelBtnClick(Sender: TObject);
begin
close;
end;
//添加彩信文件资源
procedure TNewMMS.XpBtnAddClick(Sender: TObject);
var
I: Integer;
sql:string;
smiltype:string;
mms_binary_source:PChar;
filelist:string;
total:Integer;
begin
if VSTreeResource.RootNodeCount=0 then
begin
ShowMessage('Please choose some files as MMS Resource,and try again!');
exit;
end;
//判断彩信smil版本，据此生成不同的smil文件
if RzRadioButton1.Checked=true then
begin
smiltype:='Smil 1.0';
generateSmilFile(smiltype);
fileLines.SaveToFile(GetCurrentDir+'\smil_10.smil'); //没想到TStringlist还有这么好的功能SaveToFile
end
else
begin
smiltype:='Smil 2.0';
generateSmilFile(smiltype);
fileLines.SaveToFile(GetCurrentDir+'\smil_20.smil');
end;
//将文件的绝对路径保存在链表中，作为参数供wap.dll的edit_eml调用
for I := 0 to Stringlist.Count - 1 do
begin
if i=0 then
filelist:=GetCurrentDir+'\'+Stringlist.strings
else
filelist:=filelist+';'+stringlist.strings;
end;
filelist:=filelist+';';
total:=totalSize;
//得到生成的eml文件的指针
mms_binary_source:=edit_eml(PChar(formatDatetime('yyyy-mm-dd hh:mm:ss', now)),PChar(RCBType.Text),PChar(smiltype),total,pchar(edtSubject.Text),pchar(filelist));
//StrCopy(mms_binary,mms_binary_source);
//ShowMessage(string(mms_binary_source));
//将eml文件插入数据库的blob类型的字段
sqL:='insert into mmslibrary(MMS_ID,MMS_Type,MMS_Smil,MMS_Size,MMS_Subject,MMS_Binary) values'+
'("'+formatDatetime('yyyymmddhhmmss', now)+'","'+RCbtype.Text+'","'+smiltype+'",'+inttostr(total+getFileSize(Stringlist.Strings))+',"'+
edtSubject.Text+'",'''+StringReplace(string(mms_binary_source), '''', '"', )+''')';
if Currentdatabase.ExecuteSqlNoQurey(sql)=1 then
ShowMessage('Save Script to Database Success!');
free_eml(mms_binary_source);
Close;
ModalResult:=mrOk;
end;
//初始化
procedure TNewMMS.FormCreate(Sender: TObject);
begin
currentdatabase.databases.GetByIndex(0);//连接数据库
Stringlist:=Tstringlist.Create;//create 链表
Stringlist.Add('smil_10.smil');//初始化资源链表
VSTreeResource.NodeDataSize:=SizeOf(TResource);//初始化node大小
VSTreeResource.Header.Columns.Width:=VSTreeResource.ClientWidth;
totalSize:=0;//文件初始总大小为0
RefreshTree;//刷新使得资源树显示 smil_10.smil
procedure TNewMMS.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TNewMMS.ResourceAddClick(Sender: TObject);
var
temp:Longint;
begin
//文件过滤
dlgOpenAdd.Filter:='text files(*.txt;*.html;*.htm)|*.txt;*.html;*.htm|pictual files(*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif|sound files(*.wma;*.mp3)|*.wma;*.mp3|video files(*.avi;*.mp4)|*.avi;*.mp4|';
if dlgOpenAdd.Execute then
begin
temp:=totalSize+getFileSize(dlgOpenAdd.FileName);
if temp<100000 then //the other 2400 bytes are for smil file
begin
totalSize:=temp;
Stringlist.Add(dlgOpenAdd.FileName);
edtsize.Text:=IntToStr(totalSize)+' Byte';
end
else
begin
ShowMessage('You can still add another file less large than '+inttostr(100000-totalSize)+' Byte!');
Exit;
end;
end;
RefreshTree;
getMMSContentType;
end;
procedure TNewMMS.getMMSContentType(); //获取短信类型，自动判断的哦！
var
i:Integer;
extendname:string;
text,picture,sound,video:Integer;
begin
text:=0;
picture:=0;
sound:=0;
video:=0;
if Stringlist.Count=0 then RCBType.ItemIndex:=0;
for i :=1 to Stringlist.Count - 1 do
begin
extendname:=LowerCase( RightStr(Trim(Stringlist.Strings),3));
if (extendname='txt') or (extendname='htm') or (extendname='tml') then
text:=text+1;
if (extendname='bmp') or (extendname='jpg') or (extendname='gif') then
picture:=picture+1;
if (extendname='wma') or (extendname='mp3') then
sound:=sound+1;
if (extendname='avi') or (extendname='mp4') then
video:=video+1;
end;
if (text>0) and (picture=0) and (sound=0) and (video=0) then
RCBType.ItemIndex:=0;
if (text=0) and (picture>0) and (sound=0) and (video=0) then
RCBType.ItemIndex:=1;
if (text>0) and (picture>0) and (sound=0) and (video=0) then
RCBType.ItemIndex:=2;
if (text=0) and (picture=0) and (sound>0) and (video=0) then
RCBType.ItemIndex:=3;
if (text>0) and (picture=0) and (sound>0) and (video=0) then
RCBType.ItemIndex:=4;
if (text=0) and (picture>0) and (sound>0) and (video=0) then
RCBType.ItemIndex:=5;
if (text>0) and (picture>0) and (sound>0) and (video=0) then
RCBType.ItemIndex:=6;
if (text=0) and (picture=0) and (sound=0) and (video>0) then
RCBType.ItemIndex:=7;
if (text>0) and (picture=0) and (sound=0) and (video>0) then
RCBType.ItemIndex:=8;
if (text=0) and (picture>0) and (sound=0) and (video>0) then
RCBType.ItemIndex:=9;
if (text>0) and (picture>0) and (sound=0) and (video>0) then
RCBType.ItemIndex:=10;
if (text=0) and (picture=0) and (sound>0) and (video>0) then
RCBType.ItemIndex:=11;
if (text>0) and (picture=0) and (sound>0) and (video>0) then
RCBType.ItemIndex:=12;
if (text=0) and (picture>0) and (sound>0) and (video>0) then
RCBType.ItemIndex:=13;
if (text>0) and (picture>0) and (sound>0) and (video>0) then
RCBType.ItemIndex:=14;
end;
function TNewMMS.getFileSize(sFileName:string):Longint;//获取文件的大小
var
Attrs: Word;
f: file of Byte;
size: Longint;
begin
Attrs := FileGetAttr(sFileName);
try
AssignFile(f, sFileName);
Reset(f);
size := FileSize(f);
finally
CloseFile(f);
end;
result:=size;
end;
//这个函数是使得datatree能显示的最关键函数，必须实现。详情参见virtualtree的帮助文档的描述
procedure TNewMMS.VSTreeResourceGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
i:Integer;
begin
for I := 0 to Stringlist.Count - 1 do
begin
case Column of
0: CellText:=getFilenameFromFullpath(Stringlist);
end;
end;
end;
//通过绝对路径获得文件的名字以及扩展名
function TNewMMS.getFilenameFromFullpath(s:string):string;
var
i:Integer;
temp:string;
begin
temp:=trim(s);
i:=Pos('\',temp);
while i<>0 do
begin
temp:=copy(temp,i+1,StrLen(PAnsiChar(temp))-i);
i:=Pos('\',temp);
end;
result:=temp;
end;
//删除资源树中的文件，实际有很多事要做哦
procedure TNewMMS.XpBtnDeleteClick(Sender: TObject);
var
node:PVirtualNode;
begin
if VSTreeResource.FocusedNode=nil then Exit;
node:=VSTreeResource.FocusedNode;
if node.Index=0 then Exit;
totalSize:=totalSize-getFileSize(Stringlist.Strings);
edtsize.Text:=IntToStr(totalSize)+' Byte';
Stringlist.Delete(node.Index);
RefreshTree;
getMMSContentType;
end;
procedure TNewMMS.FormDestroy(Sender: TObject);
begin
DeleteFile(stringlist.strings);
stringlist.Free;
fileLines.Free;
inherited;
end;
procedure TNewMMS.edtSubjectMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if edtsubject.Text='MMS subject' then
edtSubject.SetFocus;
end;
procedure TNewMMS.RzRadioButton1Click(Sender: TObject);
begin
Stringlist.Strings:='smil_10.smil';
RefreshTree;
end;
//生成smil文件。完全独立哦
procedure TNewMMS.generateSmilFile(smilType:string);
var
I: Integer;
extendname:string;
srcType:string;
begin
fileLines:=TStringList.Create;
fileLines.Add('<smil><head><layout><root-layout height="'+'208'+'" width="'+'176'+'"/>');
fileLines.Add('<region id="'+'regSlide0Video'+'" height="'+'100%'+'" width="'+'100%'+'" left="'+'0'+'" top="'+'0'+'" fit="'+'meet'+'" />');
fileLines.Add('</layout>');
fileLines.Add('<transition id="'+'transVideo1In'+'" type="'+'clockWipe'+'" subtype="'+'clockwiseTwelve'+'" direction="'+'forward'+'" dur="'+'1s'+'" />');
fileLines.Add('<transition id="'+'transVideo2In'+'" type="'+'barWipe'+'" subtype="'+'leftToRight'+'" direction="'+'reverse'+'" dur="'+'2s'+'" />');
fileLines.Add('<transition id="'+'transVideo2Out'+'" type="'+'clockWipe'+'" subtype="'+'clockwiseTwelve'+'" direction="'+'reverse'+'" dur="'+'1s'+'" />');
fileLines.Add('</head><body>');
for I :=1 to Stringlist.Count - 1 do
begin
extendname:=LowerCase( RightStr(Trim(Stringlist.Strings),3));
if (extendname='txt') or (extendname='htm') or (extendname='tml') then
srcType:='text';
if (extendname='bmp') or (extendname='jpg') or (extendname='gif') then
srcType:='img';
if (extendname='wma') or (extendname='mp3') then
srcType:='audio';
if (extendname='avi') or (extendname='mp4') then
srcType:='video';
fileLines.Add('<par dur="'+'2s'+'" fill="'+'hold'+'" ><'+srcType+' region="'+'regSlide0Video'+'" src="'+getFilenameFromFullpath(Stringlist)+'" fill="'+'hold'+'" dur="'+'2s'+'" /></par>');
end;
fileLines.Add('</body></smil>');
fileLines.add('<!--'+smilType +' file complete -->');
end;
procedure TNewMMS.RzRadioButton2Click(Sender: TObject);
begin
Stringlist.Strings:='smil_20.smil';
RefreshTree;
end;
end.
页:
[1]