servercontroller.pas

IntraWeb电影程序 B/S类型的演示 Delphi+Internet 开发的电影服务器 系统登录电影网站的用户名和密码都是admin 观看电影的最低要求: 请确保你的系统已经安装媒体播放

unit ServerController;

interface

uses
  SysUtils, Classes, IWServerControllerBase, IWBaseForm, HTTPApp,
  // For OnNewSession Event
  UserSessionUnit, IWApplication, IWAppForm,ADODB,DB,IWDBGrids,ShellAPI,Variants;

type
  TIWServerController = class(TIWServerControllerBase)
    procedure IWServerControllerBaseNewSession(ASession: TIWApplication;
      var VMainForm: TIWBaseForm);
    procedure IWServerControllerBaseBackButton(ASubmittedSequence,
      ACurrentSequence: Integer; AFormName: String; var VHandled,
      VExecute: Boolean);
    procedure IWServerControllerBaseCreate(Sender: TObject);
    procedure IWServerControllerBaseDestroy(Sender: TObject);
  private
  public
  end;
var
  con1: TADOConnection;
  GSkin,G:string;
  function PlayFilms(IQuery:TADOQuery;Search:string;PlayFilmNum:Integer=0):string;
  function GetLinkStringEx(Row:integer;ID,Link:String;Cof:String='';GridName:String='ComGrid'):String;
  function GetToolStr(RecNO,RecordCount,RowLimit:integer;GridID:integer;Grid:String='ComGrid'):string;
  function GetUserStr(RecNO,RecordCount,RowLimit:integer;GridID:integer;Grid:String='ComGrid'):string;
  function ShowForm(AFormName:String):boolean;
  function GetSpace(Count:integer):String;
  function HotFilms(IQuery:TADOQuery;ICount:Integer=14):string;
  function NewFilms(IQuery:TADOQuery;ICount:Integer=6):string;
  function PictureString(IPath,ISize:string):string;
  function GetLinkString(Row,ID:string;Link:String;Cof:String='';GridName:String='ComGrid'):String;  //给服务器iwdbgrid第几行处理，给服务器iwdbgrid处理的数据，在IE显示超连接
  function UserSession: TIWUserSession;
  function IWServerController: TIWServerController;
  procedure SetPage(Grid:TIWDBGrid;AValue:String);
  function PlayRM(Iflie:string):string;
  function PlayAvi(Iflie:string):string;
  function CopyDirectory(const Source, Dest: string): boolean;
  function DelDirectory(const Source:string): boolean;
  function RenDirectory(const OldName,NewName:string): boolean;
  function GetHzPy(const AHzStr: string): string;  //得到汉字着字母
  function RenString(Istring:string):string;    //替换全部
  function IIF(str, num: string): string;
  function GetHourStr:String;  
implementation

{$R *.dfm}

uses
  IWInit, IWGlobal,IWForm,IWContainer;

function GetHourStr:String;
var
  Hour,Min,Sec,MSec:word;
begin
  DecodeTime(now,Hour,Min,Sec,MSec);
  case Hour of
    0,1,2,3,4:Result:='午夜';
    5,6,7:Result:='早上';
    8,9,10:Result:='上午';
    11,12,13:Result:='中午';
    14,15,16,17,18:Result:='下午';
    19,20,21,22,23:Result:='晚上';
  end;
end;

function IIF(str, num: string): string;
begin
 begin
   if Trim(str)='' then Result:=Num
   else
   Result:=str;
 end
end;

function  RenString(Istring:string):string;
  function ReplaceText(const S,ReplacePiece,ReplaceWith: String):String;

  Var Position: Integer;
      TempStr: String;
  begin
    Position := Pos(ReplacePiece,S);
    if Position > 0 then Begin
      TempStr := S;
      Delete(TempStr,1,Position-1+Length(ReplacePiece));
      Result :=
      Copy(S,1,Position-1)+ReplaceWith+ReplaceText(TempStr,ReplacePiece,ReplaceWith) 
    End else Result := S;
  end;
begin
    Result := ReplaceText(Istring,'/','\')
end;


function GetHzPy(const AHzStr: string): string;  //得到汉字着字母
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: integer;
begin
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + char(byte('A') + j);
          break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;

function RenDirectory(const OldName,NewName:string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_RENAME;
    pFrom := PChar(OldName+#0);
    pTo := pchar(NewName+#0);
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;

function DelDirectory(const Source:string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PChar(source+#0);
    pTo := #0#0;
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;

function CopyDirectory(const Source, Dest: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := PChar(source+#0);
    pTo := PChar(Dest+#0);
    fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
  end;
  Result := (SHFileOperation(fo) = 0);
end;

function PlayAvi(Iflie:string):string;
 var
hint: string;
begin
  if Usersession.PlayFilmNum <> 0 then
   hint:='<p>'+GetSpace(18)+'当前播放电影片为  <font color=red>【'+ Usersession.Film +'】 </font> 的第<font color=red>'+IntToStr(Usersession.PlayFilmNum)+ '</font>集</p>'
   else
   hint:='<p>'+GetSpace(18)+'当前播放电影片为  <font color=red>【'+ Usersession.Film +'】 </font> </p>';
Result:=hint+'<p><OBJECT id=MediaPlayer1 height=400 width=450 classid=clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95>'+
    '<PARAM NAME="AudioStream" VALUE="-1"> '+
    '<PARAM NAME="AutoSize" VALUE="0">      '+
    '<PARAM NAME="AutoStart" VALUE="-1">  '+
    '<PARAM NAME="AnimationAtStart" VALUE="-1">'+
    '<PARAM NAME="AllowScan" VALUE="-1"> '+
    '<PARAM NAME="AllowChangeDisplaySize" VALUE="-1">'+
    '<PARAM NAME="AutoRewind" VALUE="0">  '+
    '<PARAM NAME="Balance" VALUE="0">     '+
    '<PARAM NAME="BaseURL" VALUE="">       '+
    '<PARAM NAME="BufferingTime" VALUE="5">  '+
    '<PARAM NAME="CaptioningID" VALUE="">    '+
    '<PARAM NAME="ClickToPlay" VALUE="-1">    '+
    '<PARAM NAME="CursorType" VALUE="0">   '+
    '<PARAM NAME="CurrentPosition" VALUE="-1"> '+
    '<PARAM NAME="CurrentMarker" VALUE="0">    '+
    '<PARAM NAME="DefaultFrame" VALUE="">       '+
    '<PARAM NAME="DisplayBackColor" VALUE="0"> '+
    '<PARAM NAME="DisplayForeColor" VALUE="16777215"> '+
    '<PARAM NAME="DisplayMode" VALUE="0">  '+
    '<PARAM NAME="DisplaySize" VALUE="2">  '+
    '<PARAM NAME="Enabled" VALUE="-1">      '+
    '<PARAM NAME="EnableContextMenu" VALUE="-1">  '+
    '<PARAM NAME="EnablePositionControls" VALUE="-1">  '+
    '<PARAM NAME="EnableFullScreenControls" VALUE="0">'+
    '<PARAM NAME="EnableTracker" VALUE="-1"> '+
    '<PARAM NAME="Filename" VALUE="'+Iflie+'"> '+
    '<PARAM NAME="InvokeURLs" VALUE="-1"><PARAM NAME="Language" VALUE="-1">'+
    '<PARAM NAME="Mute" VALUE="0">       '+
    '<PARAM NAME="PlayCount" VALUE="1">  '+
    '<PARAM NAME="PreviewMode" VALUE="0"> '+
    '<PARAM NAME="Rate" VALUE="1">       '+
    '<PARAM NAME="SAMILang" VALUE="">    '+
    '<PARAM NAME="SAMIStyle" VALUE="">    '+
    '<PARAM NAME="SAMIFileName" VALUE="">  '+
    '<PARAM NAME="SelectionStart" VALUE="-1">  '+
    '<PARAM NAME="SelectionEnd" VALUE="-1">  '+
    '<PARAM NAME="SendOpenStateChangeEvents" VALUE="-1"> '+
    '<PARAM NAME="SendWarningEvents" VALUE="-1">  '+
    '<PARAM NAME="SendErrorEvents" VALUE="-1">    '+
    '<PARAM NAME="SendKeyboardEvents" VALUE="0">   '+
    '<PARAM NAME="SendMouseClickEvents" VALUE="0"> '+
    '<PARAM NAME="SendMouseMoveEvents" VALUE="0">  '+
    '<PARAM NAME="SendPlayStateChangeEvents" VALUE="-1"> '+
    '<PARAM NAME="ShowCaptioning" VALUE="0">'+
    '<PARAM NAME="ShowControls" VALUE="-1"> '+
    '<PARAM NAME="ShowAudioControls" VALUE="-1">'+
    '<PARAM NAME="ShowDisplay" VALUE="0">    '+
    '<PARAM NAME="ShowGotoBar" VALUE="0">   '+
    '<PARAM NAME="ShowPositionControls" VALUE="-1"> '+
    '<PARAM NAME="ShowStatusBar" VALUE="-1">'+
    '<PARAM NAME="ShowTracker" VALUE="-1">'+
    '<PARAM NAME="TransparentAtStart" VALUE="0">'+
    '<PARAM NAME="VideoBorderWidth" VALUE="0">'+
    '<PARAM NAME="VideoBorderColor" VALUE="0">'+
    '<PARAM NAME="VideoBorder3D" VALUE="0">'+
    '<PARAM NAME="Volume" VALUE="-40"> '+
    '<PARAM NAME="WindowlessVideo" VALUE="0"></OBJECT><P>';
end;

function PlayRm(Iflie:string):string;
var hint:string;
begin
  if Usersession.PlayFilmNum <> 0 then
   hint:='<p>'+GetSpace(18)+'当前播放电影片为  <font color=red>【'+ Usersession.Film +'】</font>  的第<font color=red>'+IntToStr(Usersession.PlayFilmNum)+ '</font>集</p>'
   else
   hint:='<p>'+GetSpace(18)+'当前播放电影片为  <font color=red>【'+ Usersession.Film +'】</font></p>';
Result:=hint+'<P><object ID="video2" CLASSID="clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA" name="playfull" WIDTH="412" HEIGHT="320" >'+
      '<param name="_ExtentX" value="10901" />'+
      '<param name="_ExtentY" value="8467" />'+
      '<param name="AUTOSTART" value="-1" />'+
      '<param name="SHUFFLE" value="0" />'+
      '<param name="PREFETCH" value="0" />'+
      '<param name="NOLABELS" value="0" />'+
      '<param name="SRC" value="'+Iflie+' "/>'+
      '<param name="CONTROLS" value="ImageWindow" />'+
      '<param name="CONSOLE" value="Clip1" />'+
      '<param name="LOOP" value="0" /> '+
      '<param name="NUMLOOP" value="0" />'+
      '<param name="CENTER" value="0" /> '+
      '<param name="MAINTAINASPECT" value="0" />'+
      '<param name="BACKGROUNDCOLOR" value="#000000" />'+
      '<embed SRC="4.rpm" type="audio/x-pn-realaudio-plugin" CONSOLE="Clip1" CONTROLS="ImageWindow" HEIGHT="240" WIDTH="352" AUTOSTART="false" /></object>'+
      '<object ID="video1" CLASSID="clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA" WIDTH="412" HEIGHT="60" >'+
      '<param name="_ExtentX" value="10901" />'+
      '<param name="_ExtentY" value="1588" />'+
      '<param name="AUTOSTART" value="-1" />'+
      '<param name="SHUFFLE" value="0" />'+
      '<param name="PREFETCH" value="0" /> '+
      '<param name="NOLABELS" value="0" /> '+
      '<param name="CONTROLS" value="ControlPanel,StatusBar" /> '+
      '<param name="CONSOLE" value="Clip1" /> '+
      '<param name="LOOP" value="0" /> '+
      '<param name="NUMLOOP" value="0" /> '+
      '<param name="CENTER" value="0" /> '+
      '<param name="MAINTAINASPECT" value="0" />'+
      '<param name="BACKGROUNDCOLOR" value="#000000" /> '+
      '<embed type="audio/x-pn-realaudio-plugin" CONSOLE="Clip1" CONTROLS="ControlPanel,StatusBar" HEIGHT="60" WIDTH="275" AUTOSTART="false" /></object><p>';
end;
procedure SetPage(Grid:TIWDBGrid;AValue:String);
var
  n1,n2:integer;
begin
  n1:=StrToint(Copy(Avalue,1,1));
  n2:=StrToInt(Copy(AValue,3,20));
    Case n1 of
      0:begin
        Case n2 of
          1:Grid.DataSource.DataSet.First;
          2:Grid.DataSource.DataSet.MoveBy(-Grid.RowLimit);
          3:Grid.DataSource.DataSet.MoveBy(Grid.RowLimit);
          4:Grid.DataSource.DataSet.Last;
        end;
      end;
      1:begin
        G:=IntToStr((N2-1)*Grid.RowLimit+1);
        Grid.DataSource.DataSet.RecNo:=(N2-1)*Grid.RowLimit+1;
      end;
    end;
end;
function GetUserStr(RecNO,RecordCount,RowLimit:integer;GridID:integer;Grid:String='ComGrid'):string;
var
 P:real;
 n,n1,n2,P1,P2:integer;
 S:String;
begin
P:=RecNo/RowLimit;
P1:=Trunc(P);
if Frac(P)>0 then Inc(P1);
P:=RecordCount/RowLimit;
P2:=Trunc(P);
if Frac(P)>0 then Inc(P2);
Result:='&nbsp;&nbsp;';
if P1>1 then
begin
  Result:=Result+
                    GetLinkStringEx(GridID,'0_1','<font face="Webdings" title="首页">9</font>','',Grid)+
                    GetLinkStringEx(GridID,'0_2','<font face="Webdings" title="上一页">7</font>','',Grid)+'%S';
end else
begin
  Result:=Result+'<font face="Webdings" color=gray title="首页">9</font>'+
                                         '<font face="Webdings" color=gray title="上一页">7</font>%S';
end;
if P1<>P2 then
begin
  Result:=Result+
                    GetLinkStringEx(GridID,'0_3','<font face="Webdings" title="下一页">8</font>','',Grid)+
                    GetLinkStringEx(GridID,'0_4','<font face="Webdings" title="尾页">:</font>','',Grid);
end else
begin
  Result:=Result+'<font face="Webdings" color=gray title="下一页">8</font>'+
                                        '<font face="Webdings" color=gray title="尾页">:</font>';
end;
n1:=P1-5;
if n1<1 then n1:=1;
n2:=P1+5+ABS(P1-5-n1)-1;
if n2>P2 then n2:=P2;
s:='&nbsp;';
for n:=n1 to n2 do
begin
  if n=p1 then
     s:=s+format('<font color=red><b>%D</b></font>&nbsp;',[n]) else
     s:=S+GetLinkStringEx(GridID,'1_'+IntToStr(n),inttostr(n),'',Grid)+'&nbsp;';
end;

 Result:=format(Result,[s]);
 Result:=Result+ format('&nbsp;&nbsp;共<b>%D</b>位用户 每页<b>%D</b>位用户  共<b>%D</b>页&nbsp;&nbsp;',
       [RecordCount,RowLimit,P2]);

end;

function GetToolStr(RecNO,RecordCount,RowLimit:integer;GridID:integer;Grid:String='ComGrid'):string;
var