开源了
unit MainN;
interface
uses Windows, DSPack, Directshow9, StrUtils, SysUtils,Graphics, Classes, Controls, Forms, Menus, MMSystem, ComCtrls, ADODB, shlobj;
function GetRst(lstrSql:string):TadoDataSet;
function SetLastsName(lstr:string):string;
function GetBilInfo(lindex:integer):boolean;
function GetLastFiles(a:string;c:string):string;
function SetMenuInfos(lstr:string):string;
function SetDrivers(lstr:string):string;
function GetNullchar(lindex:integer):string;
procedure SetDriverInfo;
procedure GetVoicVolue;
procedure SetVoicVolue;
procedure SetsysIniInfo;
procedure SetSysIniInfo1;
procedure SetMoveType(ltype:integer);
procedure systemchked(lstrSql:string);
procedure SetDirFile;
procedure SetParamInfo;
procedure SetiniZfile;
procedure SetiniFfile;
Procedure PlayFile(lName:string);
procedure SetFListInfo;
procedure Setpostion(lIndex:int64);
procedure SetShowRect;
Procedure SetStatusInfo(lstr:string);
Procedure SetDirSet;
Procedure SetSizType(linted:integer);
Procedure SetPrcType(linted:integer);
procedure SetMenuLists;
procedure SetMenuInfo(ltype:integer;lstr:string);
var
HMovewidth:integer;
HMoveHeight:integer;
HstusHeight:integer;
HMoveType:integer;
HProCheck:boolean;
HVoic:boolean;
cn:TADOConnection;
rs:TadoDataSet;
VolumeType:integer;
HSizType:integer;
HPrcType:double;
HWinFull:boolean;
HOpenfs:string;
HOpenStus:int64;
strparam:array [1..2] of string;
OpenFiles:string;
Pi:integer;
ri:array [1..7] of trect;
p1:integer;
r1:array [1..5] of trect;
PStoped:string;
IsMusc:boolean;
Plength:int64;
Pposed:int64;
Prate:double;
IsExit:integer;
IsSizd:boolean;
IsMint:boolean;
rt:trect;
SystemPath:string;
PicLujin:string;
bzt:tbitmap;
SaveF:string;
implementation
uses MainF;
function GetLastFiles(a:string;c:string):string;
var
s,f:textfile;
b:string;
begin
assignfile(s,a);
assignfile(f,SaveF);
reset(s);
rewrite(f);
repeat
readln(s,b);
b:=trimleft(b);
if (c='.asx') and (lowercase(leftbstr(b,9))='<ref href') or (c='.wpl') and (lowercase(leftbstr(b,9))='<media sr') then
begin
delete(b,1,pos('"',b));
writeln(f,leftbstr(b,pos('"',b)-1));
end;
if (c='.pls') and (lowercase(leftbstr(b,4))='file') then
begin
delete(b,1,pos('=',b));
writeln(f,b);
end;
until eof(s);
closefile(s);
closefile(f);
GetLastFiles:=SaveF;
end;
Procedure SetPrcType(linted:integer);
begin
with maininfo do begin
VPind.Items[linted].Checked:=true;
case linted of
0:HPrcType:=0.5;
1:HPrcType:=1;
2:HPrcType:=2;
end;
IsSizd:=true;
SetShowRect;
end;
end;
Procedure SetSizType(linted:integer);
begin
with maininfo do
begin
VPrev.Items[HSizType].Checked:=false;
VPrev1.Items[HSizType].Checked:=false;
VPrev.Items[linted].Checked:=true;
VPrev1.Items[linted].Checked:=true;
HSizType:=linted;
IsSizd:=true;
SetShowRect;
end;
end;
Procedure SetStatusInfo(lstr:string);
begin
with maininfo.FilterGraph1 do
if Prate<>rate then rate:=prate;
if IsMusc=false then
lstr:=lstr+GetNullchar(15)+inttostr(HMovewidth)+' x '+inttostr(HMoveheight);
if Prate<>1 then
lstr:=lstr+GetNullchar(5)+'x'+floattostr(prate);
if HWinFull then
lstr:=lstr+GetNullchar(3)+extractfilename(OpenFiles);
maininfo.Titles.Caption:=lstr;
end;
procedure Setpostion(lIndex:int64);
var
c:IMediaSeeking;
a,b:int64;
begin
maininfo.FilterGraph1.QueryInterface(IMediaSeeking,c);
a:=lIndex*lLens;
b:=Plength*lLens;
c.SetPositions(a,AM_SEEKING_AbsolutePositioning,b,AM_SEEKING_AbsolutePositioning);
end;
function SetLastsName(lstr:string):string;
var
i:integer;
a:string;
begin
a:=lstr;
i:=pos('/',a);
if lowercase(leftbstr(a,7))='http://' then
repeat
delete(a,1,i);
i:=pos('/',a);
until i=0;
SetLastsName:=extractfilename(a);
end;
procedure SetFListInfo;
var
a:int64;
b:IBasicVideo;
c:IMediaSeeking;
begin
maininfo.FilterGraph1.QueryInterface(IBasicVideo,b);
HMovewidth:=0;
HMoveheight:=0;
b.get_VideoWidth(HMovewidth);
b.get_VideoHeight(HMoveheight);
IsMusc:=false;
if (HMovewidth=0) or (HMoveheight=0) then IsMusc:=true;
maininfo.FilterGraph1.QueryInterface(IMediaSeeking,c);
c.GetDuration(a);
Plength:=a div llens;
PStoped:=format('%d:%2.2d:%2.2d',[Plength div 3600000,(Plength mod 3600000) div 60000,((Plength mod 3600000) mod 60000) div 1000]);
end;
Procedure PlayFile(lName:string);
begin
if (fileexists(lName)=false) and (lowercase(leftbstr(lName,7))<>'http://') and (lowercase(leftbstr(lName,6))<>'ftp://') then exit;
OpenFiles:=lName;
with maininfo do
begin
caption:=WinTitle+' - '+SetLastsName(lName);
FilterGraph1.Active:=false;
FilterGraph1.Active:=true;
FilterGraph1.RenderFile(OpenFiles);
SetFListInfo;
IsSizd:=true;
SetShowRect;
FilterGraph1.Play;
if HOpenstus<>-1 then Setpostion(HOpenstus);
timer1.Enabled:=true;
SetMenuLists;
tlbplay.Click;
treeview1.Items[pindex].Selected:=true;
end;
end;
procedure SetShowRect;
var
b:IBasicVideo;
a:boolean;
begin
if (OpenFiles='') or (IsExit=0) then exit;
a:=IsSizd;
with maininfo do
begin
if (HSizType=1) or HWinFull then
rt:=rect(0,0,panel5.Width,panel5.Height)
else
begin
rt.Right:=HMovewidth*trunc(2*HPrcType) div 2;
if a then
if rt.Right>panel5.Width then
width:=width+rt.Right-panel5.Width;
if rt.Right>panel5.Width then
rt.Right:=panel5.Width;
case HSizType of
0:rt.Bottom:=HMoveheight*trunc(2*HPrcType) div 2;
2:rt.Bottom:=rt.Right*3 div 4;
3:rt.Bottom:=rt.Right*4 div 5;
4:rt.Bottom:=rt.Right*9 div 16;
end;
if a then
if rt.Bottom>panel5.Height then
height:=height+rt.Bottom-panel5.Height;
if rt.Bottom>panel5.Height then
rt.Bottom:=panel5.Height;
rt.Left:=(panel5.Width-rt.Right) div 2;
rt.Top:=(panel5.Height-rt.Bottom) div 2;
end;
FilterGraph1.QueryInterface(IBasicVideo,b);
b.SetDestinationPosition(rt.Left,rt.Top,rt.Right,rt.Bottom);
end;
end;
procedure SetParamInfo;
begin
if strparam[1]<>'Players' then exit;
systemchked('update 2 set [openname]="'+strparam[2]+'",[Openstatus]=0');
systemchked('delete from 0');
systemchked('insert into 0([id],[name]) values(1,"'+strparam[2]+'")');
end;
Procedure SetDirSet;
var
b:tbrowseinfo;
d:array[0..260] of char;
i:pitemidlist;
a:string;
begin
b.hwndowner:=maininfo.handle;
b.pidlroot:=nil;
b.pszdisplayname:=nil;
b.lpsztitle:='请选择一个路径:';
b.ulflags:=0;
b.lpfn:=nil;
b.lparam:=0;
b.iimage:=0;
i:=shbrowseforfolder(b);
if i=nil then exit;
shgetpathfromidlist(i,@d);
a:=string(d);
if OpenFiles<>'' then maininfo.Quit.Click;
maininfo.TreeView1.Items.Clear;
systemchked('delete from 0');
chdir(a);
SetDirFile;
end;
[解决办法]
什么东西呀，没个说明
[解决办法]
？？？？
[解决办法]
。。。。。。调戏大家？？？
