maind.pas

极具实用价值的文件管理系统

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetFileExtensionName
  Purpose:   Get File Extension Name
  Arguments: const FileName: String
  Result:    String
  Author:    Cyclone
  History:   2004-12-6 21:49:57

-----------------------------------------------------------------------------}
function TdmMain.GetFileExtensionName(const FileName: String): String;
var
  sExtensionName: String;
begin
  Result := GetFileExtension(FileName);
  if Result = '.CYC' then
  begin
    if pDatabaseType = dtAccess then
      sExtensionName := GetFieldValue('SELECT OriginalExtName FROM Documents WHERE UCASE(TRIM(FileName)) = ' + QuotedStr(UpperCase(Trim(ExtractFileName(FileName)))))
    else
      sExtensionName := GetFieldValue('SELECT OriginalExtName FROM Documents WHERE UPPER(RTRIM(FileName)) = ' + QuotedStr(UpperCase(Trim(ExtractFileName(FileName)))));
    if sExtensionName <> '' then
      Result := sExtensionName;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetRunningNoFormat
  Purpose:   Get Running No. Format
  Arguments: const Prefix, YearString, MonthString, DayString: String; NoPlace: Integer
  Result:    String
  Author:    Cyclone
  History:   2004-12-9 23:20:38

-----------------------------------------------------------------------------}
function TdmMain.GetRunningNoFormat(const Prefix, YearString, MonthString,
  DayString: String; NoPlace: Integer): String;
var
  i: Integer;
begin
  Result := Trim(Prefix) + Trim(YearString) + Trim(MonthString) + Trim(DayString);
  if NoPlace > 0 then
  begin
    for i := 1 to NoPlace - 1 do
      Result := Result + '0';
    Result := Result + '1';
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.OnTrimSetText
  Purpose:   Trim Field Value
  Arguments: Sender: TField; const Text: String
  Result:    None
  Author:    Cyclone
  History:   2004-12-9 23:33:14

-----------------------------------------------------------------------------}
procedure TdmMain.OnTrimSetText(Sender: TField;
  const Text: String);
begin
  Sender.AsString := Trim(Text);
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetFileReferenceCount
  Purpose:   Get File Reference Count
  Arguments: const FileName, DocType, DocNo: String
  Result:    Integer
  Author:    Cyclone
  History:   2004-12-11 22:12:32

-----------------------------------------------------------------------------}
function TdmMain.GetFileReferenceCount(const FileName, DocType,
  DocNo: String): Integer;
begin
  if pDatabaseType = dtAccess then
  begin
    Result := GetFieldValue(' SELECT COUNT(*) FROM Documents WHERE ' +
                            ' UCASE(TRIM(FileName)) = ' + QuotedStr(UpperCase(Trim(ExtractFileName(FileName)))) +
                            ' AND UCASE(TRIM(DocType)) <> ' + QuotedStr(UpperCase(Trim(ExtractFileName(DocType)))) +
                            ' AND UCASE(TRIM(DocNo)) <> ' + QuotedStr(UpperCase(Trim(ExtractFileName(DocNo)))))
  end
  else
  begin
    Result := GetFieldValue(' SELECT COUNT(*) FROM Documents WHERE ' +
                            ' UPPER(RTRIM(FileName)) = ' + QuotedStr(UpperCase(Trim(ExtractFileName(FileName)))) +
                            ' AND UPPER(RTRIM(DocType)) <> ' + QuotedStr(UpperCase(Trim(ExtractFileName(DocType)))) +
                            ' AND UPPER(RTRIM(DocNo)) <> ' + QuotedStr(UpperCase(Trim(ExtractFileName(DocNo)))));
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.DeleteCYCFile
  Purpose:   Delete CYC File
  Arguments: const FileName, DocType, DocNo: String
  Result:    Boolean
  Author:    Cyclone
  History:   2004-12-11 22:21:11

-----------------------------------------------------------------------------}
function TdmMain.DeleteCYCFile(const FileName, DocType,
  DocNo: String): Boolean;
begin
  Result := False;
  if GetFileReferenceCount(FileName, DocType, DocNo) = 0 then
    Result := DeleteFile(pRootPath + FileName);
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetCategoryPath
  Purpose:   Get Document Type Path
  Arguments: TypeCode: String
             Path: String
  Result:    String
  Author:    Cyclone
  History:   2004-12-12 20:58:11

-----------------------------------------------------------------------------}
procedure TdmMain.GetCategoryPath(const TypeCode: String; var Path: String);
var
  sTypeCode,
  sTypeName: String;
begin
  if Trim(TypeCode) = '' then
    Path := '[' + pSystemName + ']'
  else
  begin
    //dsCategoryTree.Close;
    //dsCategoryTree.Open;
    if dsCategoryTree.Locate('TypeCode', TypeCode, [loCaseInsensitive]) then
    begin
      sTypeCode := Trim(dsCategoryTree.FieldByName('ParentTypeCode').AsString);
      sTypeName := Trim(dsCategoryTree.FieldByName('TypeName').AsString);
      if sTypeCode = '' then
        Path := '[' + pSystemName + ']' + '\' + sTypeName + '\' + Path
      else
      begin
        Path := sTypeName + '\' + Path;
        GetcategoryPath(sTypeCode, Path);
      end;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetCategoryName
  Purpose:   Get Document Category Name
  Arguments: const TypeCode: String
  Result:    String
  Author:    Cyclone
  History:   2004-12-13 0:18:35

-----------------------------------------------------------------------------}
function TdmMain.GetCategoryName(const TypeCode: String): String;
begin
  Result := '';
//  dsCategoryTree.Close;
//  dsCategoryTree.Open;
  if dsCategoryTree.Locate('TypeCode', TypeCode, [loCaseInsensitive]) then
    Result := dsCategoryTree.FieldByName('TypeName').AsString;
end;

{-----------------------------------------------------------------------------
  Procedure: TdmMain.GetRunningNo
  Purpose:   Get Running No
  Arguments: Prefix,
             YearString,
             MonthString,
             DayString: String;
             NoPlace: Integer
  Result:    String
  Author:    Cyclone
  History:   2004-12-23 21:45:08

-----------------------------------------------------------------------------}
function TdmMain.GetRunningNo(const Prefix, YearString, MonthString,
  DayString: String; NoPlace: Integer): String;
var
  ServerDate: TDateTime;
  sMaxRunningNo: String;
  iMaxRunningNo: Integer;
  bIsExist: Boolean;
begin
  Result := Trim(Prefix) + Trim(YearString) + Trim(MonthString) + Trim(DayString);
  ServerDate := GetServerDatetime(pDatabaseType);;
  Result := AnsiReplaceStr(Result, 'YYYY', IntToStr(YearOf(ServerDate)));
  Result := AnsiReplaceStr(Result, 'YY', RightStr(IntToStr(YearOf(ServerDate)), 2));
  Result := AnsiReplaceStr(Result, 'MM', PadLeft(IntToStr(MonthOf(ServerDate)), '0', 2));
  Result := AnsiReplaceStr(Result, 'DD', PadLeft(IntToStr(DayOf(ServerDate)), '0', 2));
  sMaxRunningNo := VarToStr(GetFieldValue('SELECT MAX(DocNo) FROM Documents WHERE LEFT(DocNo, ' + IntToStr(Length(Result)) + ') = ' + QuotedStr(Result)));
  iMaxRunningNo := StrToIntDef(Copy(sMaxRunningNo, Length(Result) + 1, Length(sMaxRunningNo)), 0) + 1;
  sMaxRunningNo := Result + PadLeft(IntToStr(iMaxRunningNo), '0', NoPlace);
  bIsExist := IsExists('SELECT DocNo FROM Documents WHERE DocNo = ' + QuotedStr(sMaxRunningNo));
  while bIsExist do
  begin
    Inc(iMaxRunningNo);
    sMaxRunningNo := Result + PadLeft(IntToStr(iMaxRunningNo), '0', NoPlace);
    bIsExist := IsExists('SELECT DocNo FROM Documents WHERE DocNo = ' + QuotedStr(sMaxRunningNo));
  end;
  Result := sMaxRunningNo;
end;


end.