fcontrol.pas

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

unit FControl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent,
  IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML,
  IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl,
  IWBaseHTMLControl, IWControl, IWCompEdit, IWHTMLControls, IWCompMemo,
  IWCompListbox, IWCompLabel,DB,ADODB, IWLayoutMgrHTML, IWLayoutMgrForm,
  IWCompCheckbox, IWGrids, IWDBGrids,Iwhtmltag;

type
  TModiforAddForm = class(TBaseForm)
    IWLabel1: TIWLabel;
    TitleEdt: TIWEdit;
    IWLabel2: TIWLabel;
    IWLabel3: TIWLabel;
    IWLabel4: TIWLabel;
    IWLabel5: TIWLabel;
    IWLabel7: TIWLabel;
    MainNameEdt: TIWEdit;
    UpTimEdt: TIWEdit;
    TypeIdCbb: TIWComboBox;
    Memo: TIWMemo;
    IWLabel8: TIWLabel;
    IWLabel9: TIWLabel;
    IWLabel11: TIWLabel;
    IWLabel10: TIWLabel;
    IWLabel12: TIWLabel;
    FilmLong: TIWComboBox;
    whereEdt: TIWEdit;
    IWLabel13: TIWLabel;
    UpFilms: TIWButton;
    UpFilelist: TIWMemo;
    FilmNumEdt: TIWCheckBox;
    IWLabel6: TIWLabel;
    BackBtn: TIWButton;
    SearchFilm: TIWButton;
    LookBtn: TIWButton;
    ComGrid: TIWDBGrid;
    EdtNumTo: TIWEdit;
    SaveFilmCbb: TIWComboBox;
    SaveFilmEdt: TIWEdit;
    SavePictureEdt: TIWEdit;
    UpFilm: TIWEdit;
    UpPictrueEdt: TIWEdit;
    EdtNumFrom: TIWEdit;
    procedure IWAppFormRender(Sender: TObject);
    procedure UpFilmsClick(Sender: TObject);
    procedure IWAppFormCreate(Sender: TObject);
    procedure BackBtnClick(Sender: TObject);
    procedure ComGridColumns1Click(ASender: TObject; const AValue: String);
    procedure LookBtnClick(Sender: TObject);
    procedure SearchFilmClick(Sender: TObject);
    procedure SaveFilmCbbHTMLTag(ASender: TObject; ATag: TIWHTMLTag);
  private
    { Private declarations }
  public
   procedure GetField(IQuery:Tadoquery);
   procedure SetField(IQuery:Tadoquery);
   procedure Textclear;
    { Public declarations }
  end;

var
  ModiforAddForm: TModiforAddForm;

implementation
        uses ServerController,Fadminform,FMainForm,FplayForm;
{$R *.dfm}

procedure TModiforAddForm.Textclear;
var
  i:Integer;
begin
  for i:=0 to self.ComponentCount-1 do begin
    if (self.Components[i] is TIWEdit )then
      begin
         IF (self.Components[i] as TIWEdit).Name <> 'EdtNumFrom' then
         (self.Components[i] as TIWEdit).Text:='';
      end;
    if (self.Components[i] is TIWComboBox )then
      begin
        (self.Components[i] as TIWComboBox).ItemIndex:=-1;
      end;
     Memo.Lines.Clear;
     UpFilelist.Lines.Clear;
  end;

end;
procedure TModiforAddForm.GetField(IQuery: Tadoquery);
var
  AdoTempMovieList:TADOQuery;
begin
 Textclear;
 with IQuery do begin
   TitleEdt.Text:= FieldBYname('title').AsString;
   SavePictureEdt.Text:=FieldBYname('url').AsString;
   TypeIdCbb.ItemIndex:=TypeIdCbb.Items.IndexOf(FieldBYname('Typeid').AsString);
   MainNameEdt.Text :=  FieldBYname('name').AsString;
   uptimedt.Text :=  FieldBYname('dateandtime').AsString;
   whereEdt.Text :=FieldByname('where').AsString;
   FilmLong.ItemIndex :=FilmLong.Items.IndexOf(FieldByName('howlong').AsString);
   Memo.Text:=FieldByname('content').AsString;
   FilmNumEdt.Checked:=FieldByName('IsFilmNum').AsBoolean;
   UpFilelist.Lines.Add(FieldByName('domurl').AsString);
  
   SaveFilmEdt.Text:=FieldByName('domurl').AsString;
   UpFilm.Text:=Copy(WebApplication.ApplicationPath,0,Length(WebApplication.ApplicationPath)-1)+RenString(SaveFilmEdt.Text);
   UpPictrueEdt.Text:=Copy(WebApplication.ApplicationPath,0,Length(WebApplication.ApplicationPath)-1)+RenString(SavePictureEdt.Text);
   //SaveFilmCbb.ItemIndex:=SaveFilmCbb.Items.IndexOf(FieldBYname('Typeid').AsString);
 end;

   if  IQuery.FieldByName('IsFilmNum').AsBoolean =True then  begin
       AdoTempMovieList:=TADOQuery.Create(self);
       AdoTempMovieList.Connection:=con1;
       with AdoTempMovieList do begin
         Close;
         SQL.Clear;
         SQL.Add('select * from movieList where title='+QuotedStr(IQuery.FieldByname('title').AsString));
         Open;
         UpFilelist.Lines.Clear;
         while not Eof do begin
            UpFilelist.Lines.Add(FieldBYname('playurl').AsString);
            Next;
         end;
       end;
       AdoTempMovieList.Close;
       AdoTempMovieList.Free;
   end;
end;

procedure TModiforAddForm.SetField(IQuery: Tadoquery);
var
  AdoTempMovieList:TADOQuery;
  i:Integer;
begin
 with IQuery do begin
   FieldBYname('title').AsString:= TitleEdt.Text;
   FieldBYname('url').AsString:=SavePictureEdt.Text;
   FieldBYname('Typeid').AsString:=TypeIdCbb.Items[TypeIdCbb.ItemIndex];
   FieldBYname('name').AsString:=  MainNameEdt.Text;
   if UpTimEdt.Text<>'' then UpTimEdt.Text:=DateToStr(Now);
   FieldBYname('dateandtime').AsString := uptimedt.Text ;
   FieldByname('where').AsString:=whereEdt.Text;
   FieldByName('howlong').AsString:=FilmLong.Items[FilmLong.ItemIndex];
   FieldByname('content').AsString:=Memo.Text;
   FieldByName('IsFilmNum').AsBoolean:=FilmNumEdt.Checked;
   FieldByName('domurl').AsString:=UpFilelist.Lines.Strings[0];
 end;

   if  (FilmNumEdt.Checked =True) and (UpFilelist.Lines.Text <> '') then  begin
       AdoTempMovieList:=TADOQuery.Create(self);
       AdoTempMovieList.Connection:=con1;
        with AdoTempMovieList do begin
         Close;
         SQL.Clear;
         SQL.Add('delete from movieList where title='+QuotedStr(TitleEdt.Text));
         ExecSQL;
       end;
        with AdoTempMovieList do begin
         Close;
         SQL.Clear;
         SQL.Add('select * from movieList where 1=2 ');
         Open;  
            for i:=0 to UpFilelist.Lines.Count-1 do  begin
                Append ;
                FieldBYname('title').AsString:=IQuery.FieldBYname('title').AsString;
                FieldBYname('playurl').AsString:=UpFilelist.Lines.Strings[i];
                FieldBYname('Filmnum').AsInteger:=i+1;
                Post;
             end;
             IQuery.FieldByName('domurl').AsString:='';
       end;
       AdoTempMovieList.Close;
       AdoTempMovieList.Free;
   end;


end;

procedure TModiforAddForm.IWAppFormRender(Sender: TObject);
begin
  inherited;
 if UserSession.isEditAppendFilm ='append' then  begin
       UpFilms.Caption:='添加';
   if not UserSession.IsFresh then
   Textclear;
   UserSession.IsFresh :=False;
  end
 else  begin
   UpFilms.Caption:='修改';
   UserSession.ListFilm.Locate('title',usersession.isEditAppendFilm,[]);
   if not UserSession.IsFresh then
   GetField(UserSession.ListFilm);
   UserSession.isEditAppendFilm:='';
   UserSession.IsFresh :=False;
 end;

end;

procedure   TModiforAddForm.UpFilmsClick(Sender: TObject);
begin
  inherited;
  if UpFilms.Caption='添加' then   begin
    with UserSession.ListFilm do begin
       Close;
       SQL.Clear;
       SQL.Add('select * from movie where 1=2 ');
       Open;
       Append;
       SetField(usersession.ListFilm);  
       Post;
    end;
    UserSession.IsFresh :=true;
   end
   else  begin       //修改
       with UserSession.ListFilm do begin
        Locate('title',usersession.isEditAppendFilm,[]);
        Edit;
        SetField(usersession.ListFilm);
        Post;
       end;
       UserSession.IsFresh :=true;
    end ;
   SearchFilm.Caption:='初始化配置'; 
end;

procedure TModiforAddForm.IWAppFormCreate(Sender: TObject);
var
  AdoTempType:TADOQuery;
begin
  inherited;
   AdoTempType:=TADOQuery.Create(self);
   AdoTempType.Connection:=con1;
   with AdoTempType do begin
     Close;
     SQL.Clear;
     SQL.Text:='select * from type';
     Open;
     while not eof do begin
       TypeIdCbb.Items.Add(Fieldbyname('type').AsString);
       SaveFilmCbb.Items.Add(Fieldbyname('type').AsString);
       Next;
     end;
     Close;
     AdoTempType.Free;
   end;

end;

procedure TModiforAddForm.BackBtnClick(Sender: TObject);
begin
  inherited;  
if not ShowForm('AdminForm') then TAdminForm.Create(WebApplication).Show;
end;

procedure TModiforAddForm.ComGridColumns1Click(ASender: TObject;
  const AValue: String);
begin
  inherited;
If AValue ='MainForm' then
  begin
   if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show;
 end  
 else
   begin
   UserSession.FilMType:=AValue;
   if not ShowForm('AdminForm') then TAdminForm.Create(WebApplication).Show;
   end;
end;

procedure TModiforAddForm.LookBtnClick(Sender: TObject);
begin
  inherited;
if not ShowForm('PlayForm') then TPlayForm.Create(WebApplication).Show;
  UserSession.Film:=TitleEdt.Text;
end;

procedure TModiforAddForm.SearchFilmClick(Sender: TObject);
 var
 GetPicName,GetFilmExt,GetFilename,GetHz:string;
 I,FromNum,toNum:Integer;
  function GetLastDir(Istring: string): string;
  var
     count:Integer;
     Fstring:string;
  begin
  Fstring:=Istring;
  count:=LastDelimiter('\', Fstring);
  result:=Copy(Fstring,Count+1,Length(Fstring)-count);
  end;

procedure  CopyOneFilm;
var NewFilms:string;
begin
NewFilms:=Copy(WebApplication.ApplicationPath,0,Length(WebApplication.ApplicationPath)-1)+RenString(SaveFilmEdt.Text)+gethzPy(TitleEdt.Text)+'\';
if not DirectoryExists(NewFilms) then
ForceDirectories(PChar(NewFilms));
CopyFile(PChar(UpFilm.Text),PChar(NewFilms+getfilename),False);//电影
CopyFile(PChar(UpPictrueEdt.Text),PChar(NewFilms+getpicname),False); //图片
end;

procedure  CopyDirFilm;
var
 Dir,DestDir:string;
 HZ,LastDir:string;

begin
  HZ:=gethzPy(TitleEdt.Text)+'\';
  DestDir:=Copy(WebApplication.ApplicationPath,0,Length(WebApplication.ApplicationPath)-1)+RenString(SaveFilmEdt.Text);
  Dir:=ExtractFileDir(UpFilm.Text);
  if not DirectoryExists(DestDir) then
  ForceDirectories(PChar(DestDir));
  CopyDirectory(Dir,DestDir);     //gethzPy(TitleEdt.Text)
  LastDir:=GetLastDir(dir);
  RenDirectory(DestDir+Lastdir,DestDir+hz);
  CopyFile(PChar(UpPictrueEdt.Text),PChar(DestDir+hz+getpicname),False); //图片
end;

begin
  inherited;
  try
   GetFilmExt:=extractfileext(UpFilm.Text);
   GetFilename:=ExtractFileName(UpFilm.Text);
   GetPicName :=ExtractFileName(UpPictrueEdt.Text);
   UserSession.IsFresh:=True;
  if FilmNumEdt.Checked=True  then begin
    upfilelist.Lines.clear;
    FromNum:= StrToIntDef(EdtNumFrom.Text,1);
    toNum:= strtointdef(EdtNumTo.Text,0);
    GetFilename:=Copy(GetFilename,0,Length(GetFilename)-(length(GetFilmExt)+1));
    for i:=FromNum to toNum do begin
      upfilelist.Lines.add(SaveFilmEdt.text+GetFilename+inttostr(i)+GetFilmExt);
    end;
     GetHz:=SaveFilmEdt.text+GetHzPy(TitleEdt.Text)+'/';
     SavePictureEdt.Text:=GetHz+GetpicName;
     CopyDirFilm;
    EdtNumFrom.Text:='0';
    EdtNumto.Text:='0';
  end
  else
   begin
     GetHz:=SaveFilmEdt.text+GetHzPy(TitleEdt.Text)+'/';
     SavePictureEdt.Text:=GetHz+GetpicName;
     upfilelist.Lines.clear;
     upfilelist.Lines.add(GetHz+Getfilename);
     CopyOneFilm;
   end;
   SearchFilm.Caption:='初始化成功';
 except
   SearchFilm.Caption:='初始化失败';
 end;
end;

procedure TModiforAddForm.SaveFilmCbbHTMLTag(ASender: TObject;
  ATag: TIWHTMLTag);
begin
  inherited;
  ATag.AddStringParam('onchange','CBB_onchange()'); 
end;

initialization
  RegisterClass(TModiforAddForm);
end.