Лингрин :: Резиденция Линды Кайе — @дневники: асоциальная сеть

воскресенье, 23 ноября 2008

14:37

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-03-44
#original-date: 22.11.2008 Sat
#original-time: 3:44 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

Мдя... Только повоевала в Антидогме по поводу наездов на Mail.ru, как уже снова крики, на этот раз уже от каких-то православных деятелей. При чём наезды ещё более идиотские, но товарищи, что удивительно, всёже умудрились найти куда стучать ^^ Честь им и хвала ^^

http://blogs.mail.ru/community/blogs_dev/6E456F7AA5C3251D.html

URL

14:36

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-03-05
#original-date: 22.11.2008 Sat
#original-time: 3:05 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

А вот и скрипт, который создаёт файлы, отвечающие за обновление сайта. Код более читабелен, работа со строками выглядит гораздо лучше... Вот для начала код на... А, ладно ^^ Покажу все версии. Итак, для начала старая версия на VB:

Attribute VB_Name = "modMain"
Option Explicit

' Need for Setup Toolkit...
Declare Sub Dummy Lib "AJPappsSupport0100.DLL" ()

Dim CurrYear As Long
Dim ChangedFiles As Collection

'====================================================================
Private Sub PrintFiles(ByVal FF As ajpFoundedFiles)
  Dim TMP As FoundedFile
  
  For Each TMP In FF
    If (TMP.FileAttributes And FILE_ATTRIBUTE_HIDDEN) = 0 Then
      If TMP.Childs.HasSubItems Then
        PrintFiles TMP.Childs
      Else
        Dim DT As Date
        Dim FileName As BStr
        
        FileName = asBuildFileName(TMP.Path, TMP.FileName)
        If Year(TMP.LastWriteTime) > 1990 Then
          ChangedFiles.Add FileName
        End If
      End If
    End If
  Next TMP
End Sub

'====================================================================
Public Sub Main()
  Dim FF As ajpFoundedFiles
  Set FF = New ajpFoundedFiles
  
  Dim RC As Boolean
  RC = FF.Refresh("\", "*.*")
  
  If Not RC Then
    MsgBox "Не удалось найти ни одного файла. Странно O_o", vbExclamation
    Exit Sub
  End If
  
  CurrYear = Year(Now)
  Set ChangedFiles = New Collection
  
  PrintFiles FF
  GenerateChangeLog
  GenerateRARList
  GenerateBAT
  
  Set FF = Nothing
  
  MsgBox "Готово!", vbInformation
End Sub

'====================================================================
Private Sub GenerateBAT()
  Dim hFile As VB_FILE_NUMBER
  
  hFile = FreeFile
  Open asBuildFileName(App.Path, "packit.bat") For Output As #hFile
    Print #hFile, "CALL ADD2RAR2L.BAT ""Site Update.RAR"" @rarlist.txt"
  Close #hFile
End Sub

'====================================================================
Private Sub GenerateRARList()
  Dim hFile As VB_FILE_NUMBER
  Dim TMP As Long
  Dim Persistent() As BStr
  
  Persistent = GetPersistentFilesList()
  
  hFile = FreeFile
  Open asBuildFileName(App.Path, "rarlist.txt") For Output As #hFile
    For TMP = 1 To ChangedFiles.Count
      If Not IsPersistentFile(ChangedFiles(TMP), Persistent) Then
        Print #hFile, GetRARFile(ChangedFiles(TMP))
      End If
    Next TMP
    
    For TMP = LBound(Persistent) To UBound(Persistent)
      Print #hFile, GetRARFile(Persistent(TMP))
    Next TMP
  Close #hFile
End Sub

Private Function GetRARFile(ByVal FileName As BStr) As BStr
  GetRARFile = Replace(FileName, "\", "/")
End Function

'====================================================================
Private Function GetChangelogFileName() As BStr
  GetChangelogFileName = Format(Now, "yyyy\_mm\_dd\.\h\t\m")
End Function

Private Function GetPersistentFilesList() As BStr()
  Dim Persistent(0 To 4) As BStr
  
  Persistent(0) = "\index.htm"
  Persistent(1) = "\about.htm"
  Persistent(2) = "\lindachan_rss.xml"
  Persistent(3) = "\news\" & GetChangelogFileName()
  Persistent(4) = "\news\old_news.htm"
  
  GetPersistentFilesList = Persistent()
End Function

Private Function IsPersistentFile(ByVal FileName As BStr, _
                                  ByRef Persistent() As BStr) As Boolean
  Dim nPersistent As Long
  
  For nPersistent = LBound(Persistent) To UBound(Persistent)
    If FileName = Persistent(nPersistent) Then
      IsPersistentFile = True
      Exit Function
    End If
  Next nPersistent
  
  IsPersistentFile = False
End Function

'====================================================================
Private Sub GenerateChangeLog()
  Dim hFile As VB_FILE_NUMBER
  Dim TMP As Long
  Dim Persistent() As BStr
  Dim Title As BStr
  Dim AppVersion As BStr
  
  Persistent() = GetPersistentFilesList
  Title = Format(Now, "d\.mm\.yyyy")
  AppVersion = App.Title & " " & asFormatVersion(App.Major, App.Minor, App.Revision)
  
  hFile = FreeFile
  Open asBuildFileName(App.Path, GetChangelogFileName) For Output As #hFile
    Print #hFile, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"""
    Print #hFile, "                      ""http://www.w3c.org/TR/REC-html40/strict.dtd"">"
    Print #hFile, "<HTML LANG=""ru"">"
    Print #hFile, "<HEAD>"
    Print #hFile, "  <META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=windows-1251"">"
    Print #hFile, "  <META HTTP-EQUIV=""Generator""    CONTENT=""" & AppVersion & """>"
    Print #hFile, "  <META HTTP-EQUIV=""Author""       CONTENT=""Линда Кайе"">"
    Print #hFile, "  <META HTTP-EQUIV=""Copyright""    CONTENT=""Линда Кайе 2007. Посвящается Ариэль."">"
    Print #hFile, "  <META HTTP-EQUIV=""Reply-To""     CONTENT=""lindakaioh@mail.ru"">"
    Print #hFile, "  <META HTTP-EQUIV=""ProgId""       CONTENT=""ANPFile"">"
    Print #hFile, "  "
    Print #hFile, "  <TITLE>Мой маленький мир :: Changelog " & Title & "</TITLE>"
    Print #hFile, "  "
    Print #hFile, "  <LINK REL=""SHORTCUT ICON"" HREF=""/favicon.ico"" TYPE=""image/x-icon"">"
    Print #hFile, "  <LINK REL=""ALTERNATE"" HREF=""http://purl.oclc.org/Linda_Kaioh/Homepage/lindachan_rss.xml"""
    Print #hFile, "        TYPE=""application/rss+xml"" TITLE=""RSS 2.00"">"
    Print #hFile, "  <LINK REL=""STYLESHEET"" HREF=""/lindachan.css"" TYPE=""text/css"">"
    Print #hFile, "</HEAD>"
    Print #hFile, "<BODY>"
    Print #hFile, ""
    Print #hFile, "<PRE STYLE=""padding:0px;margin:0px;font:10pt 'Courier New','Andale Mono',monospace;"">"
    
    Print #hFile, "<B># " & Title & "</B>"
    Print #hFile, "<B># ==========</B>"
    Print #hFile, ""
    
    For TMP = 1 To ChangedFiles.Count
      If Not IsPersistentFile(ChangedFiles(TMP), Persistent) Then
        Print #hFile, GetLink(ChangedFiles(TMP))
      End If
    Next TMP
    
    Print #hFile, ""
    Print #hFile, "<B># Всегда обновляется</B>"
    Print #hFile, ""
    
    For TMP = LBound(Persistent) To UBound(Persistent)
      Print #hFile, GetLink(Persistent(TMP))
    Next TMP
    
    Print #hFile, ""
    Print #hFile, "<B># ==========</B>"
    Print #hFile, "<B># Generator: " & AppVersion & "</B>"
    Print #hFile, "<B># Date:      " & Format(Now, "d.mm.yyyy") & " @ " & Format(Now, "h:nn:ss AM/PM") & "</B>"
    
    Print #hFile, "</PRE>"
    Print #hFile, "</BODY>"
    Print #hFile, "</HTML>"
  Close #hFile
End Sub

Private Function GetLink(ByVal FileName As BStr) As BStr
  FileName = Replace(FileName, "\", "/")
  GetLink = "<A HREF=""" & FileName & """>" & FileName & "</A>"
End Function

Потом на C. Самая мутотень, а код класса коллекции я выкладывала ранее. Большая часть кода порождена работой с файлом и жонглированием строками.

#include <AJP System.H>
#include <AJP Console.H>
#include <xShlWAPI.H>
#include "Collection.H"

//===================================================================
VOID GetDateTime(LPSTR szDateTime)
{
  SYSTEMTIME ST;
  GetLocalTime(&ST);
  
  char AMPM[6] = "\0";
  if (ST.wHour == 0) {
    ST.wHour = 12;
    lstrcpy(AMPM, "AM");
  } else if (ST.wHour > 12) {
    ST.wHour = ST.wHour - 12;
    lstrcpy(AMPM, "PM");
  } else if (ST.wHour == 12) {
    lstrcpy(AMPM, "PM");
  } else {
    lstrcpy(AMPM, "AM");
  }
  
  wsprintf(szDateTime, "%d.%02d.%04d @ %d:%02d:%02d %s",
           ST.wDay, ST.wMonth, ST.wYear,
           ST.wHour, ST.wMinute, ST.wSecond, AMPM);
}

//===================================================================
VOID GetTitle(LPSTR szTitle)
{
  SYSTEMTIME ST;
  GetLocalTime(&ST);
  
  wsprintf(szTitle, "%d.%02d.%04d",
           ST.wDay, ST.wMonth, ST.wYear);
}

//===================================================================
VOID GetChangelogFileName(LPSTR szFileName)
{
  SYSTEMTIME ST;
  GetLocalTime(&ST);
  
  wsprintf(szFileName, "%04d_%02d_%02d.htm",
           ST.wYear, ST.wMonth, ST.wDay);
}

//===================================================================
VOID GetRARFile(LPSTR Buff)
{
  for (DWORD TMP = 0; TMP < (DWORD)lstrlen(Buff); TMP++) {
    if (Buff[TMP] == '\\') Buff[TMP] = '/';
  }
  //cout << Buff << endl;
}

//===================================================================
BOOL IsPersistentFile(LPSTR       FileName,
                      CCollection *PersistentList)
{
  for (DWORD TMP = 0; TMP < PersistentList->Count(); TMP++) {
    if (lstrcmpi(FileName, PersistentList->Item(TMP)) == 0) return TRUE;
  }
  return FALSE;
}

//===================================================================
VOID WriteLine(HANDLE hFile,
               LPSTR  Text)
{
  char Buff[1025] = "\0";
  DWORD lpWritten = 0;
  
  lstrcpy(Buff, Text);
  lstrcat(Buff, "\r\n");
  
  WriteFile(hFile, &Buff[0], lstrlen(Buff), &lpWritten, NULL);
}

VOID WriteText(HANDLE hFile,
               LPSTR  Text)
{
  char Buff[1025] = "\0";
  DWORD lpWritten = 0;
  
  lstrcpy(Buff, Text);
  
  WriteFile(hFile, &Buff[0], lstrlen(Buff), &lpWritten, NULL);
}

//===================================================================
VOID GetLink(LPSTR FileName,
             LPSTR OutBuff)
{
  char Buff[1024] = "\0";
  
  lstrcpy(Buff, FileName);
  GetRARFile(Buff);
  
  wsprintf(OutBuff, "<A HREF=\"%s\">%s</A>", Buff, Buff);
}

//===================================================================
VOID GenerateChangeLog(CCollection *FoundedFiles, 
                       CCollection *PersistentList)
{
  char Buff[1025] = "\0";
  
  char ChangeLogFile[100] = "\0";
  GetChangelogFileName(ChangeLogFile);
  
  char Title[100] = "\0";
  GetTitle(Title);
  
  HANDLE hFile = CreateFile(ChangeLogFile, GENERIC_WRITE, 
                            0, NULL, CREATE_ALWAYS, 0, 0);
  if (hFile != INVALID_HANDLE_VALUE) {
    WriteLine(hFile, "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"");
    WriteLine(hFile, "                      \"http://www.w3c.org/TR/REC-html40/strict.dtd\">");
    WriteLine(hFile, "<HTML LANG=\"ru\">");
    WriteLine(hFile, "<HEAD>");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=windows-1251\">");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"Generator\"    CONTENT=\"AJPapps - News list generator 2, ver. 1.00.0001\">");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"Author\"       CONTENT=\"Линда Кайе\">");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"Copyright\"    CONTENT=\"Линда Кайе 2008. Посвящается Ариэль.\">");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"Reply-To\"     CONTENT=\"lindakaioh@mail.ru\">");
    WriteLine(hFile, "  <META HTTP-EQUIV=\"ProgId\"       CONTENT=\"ANPFile\">");
    WriteLine(hFile, "  ");
    WriteText(hFile, "  <TITLE>Мой маленький мир :: Changelog ");
      WriteText(hFile, Title);
      WriteLine(hFile, "</TITLE>");
    WriteLine(hFile, "  ");
    WriteLine(hFile, "  <LINK REL=\"SHORTCUT ICON\" HREF=\"/favicon.ico\" TYPE=\"image/x-icon\">");
    WriteLine(hFile, "  <LINK REL=\"ALTERNATE\" HREF=\"http://purl.oclc.org/Linda_Kaioh/Homepage/lindachan_rss.xml\"");
    WriteLine(hFile, "        TYPE=\"application/rss+xml\" TITLE=\"RSS 2.00\">");
    WriteLine(hFile, "  <LINK REL=\"STYLESHEET\" HREF=\"/lindachan.css\" TYPE=\"text/css\">");
    WriteLine(hFile, "</HEAD>");
    WriteLine(hFile, "<BODY>");
    WriteLine(hFile, "");
    WriteLine(hFile, "<PRE STYLE=\"padding:0px;margin:0px;font:10pt 'Courier New','Andale Mono',monospace;\">");
    
    WriteText(hFile, "<B># ");
      WriteText(hFile, Title);
      WriteLine(hFile, "</B>");
    WriteLine(hFile, "<B># ==========</B>");
    WriteLine(hFile, "");
    
    for (DWORD TMP = 0; TMP < FoundedFiles->Count(); TMP++) {
      lstrcpy(Buff, FoundedFiles->Item(TMP));
      if (!IsPersistentFile(Buff, PersistentList)) {
        char NewBuff[1024] = "\0";
        GetLink(Buff, NewBuff);
        WriteLine(hFile, NewBuff);
      }
    }
    
    WriteLine(hFile, "");
    WriteLine(hFile, "<B># Всегда обновляется</B>");
    WriteLine(hFile, "");
    
    for (TMP = 0; TMP < PersistentList->Count(); TMP++) {
      char NewBuff[1024] = "\0";
      lstrcpy(Buff, PersistentList->Item(TMP));
      GetLink(Buff, NewBuff);
      WriteLine(hFile, NewBuff);
    }
    
    char DateTime[100] = "\0";
    GetDateTime(DateTime);
    
    WriteLine(hFile, "");
    WriteLine(hFile, "<B># ==========</B>");
    WriteLine(hFile, "<B># Generator: AJPapps - News list generator 2, ver. 1.00.0001</B>");
    WriteText(hFile, "<B># Date:      ");
      WriteText(hFile, DateTime);
      WriteLine(hFile, "</B>");
    
    WriteLine(hFile, "</PRE>");
    WriteLine(hFile, "</BODY>");
    WriteLine(hFile, "</HTML>");
    
    CloseHandle(hFile);
    
    cout << ChangeLogFile << " file created." << endl;
    //cout << endl;
  }
  else {
    cout << "Error creating " << ChangeLogFile << " file." << endl;
    //cout << endl;
  }
}

//===================================================================
VOID GenerateRARList(CCollection *FoundedFiles, 
                     CCollection *PersistentList)
{
  HANDLE hFile = CreateFile("rarlist.txt", GENERIC_WRITE, 
                            0, NULL, CREATE_ALWAYS, 0, 0);
  if (hFile != INVALID_HANDLE_VALUE) {
    char Buff[1025] = "\0";
    
    for (DWORD TMP = 0; TMP < FoundedFiles->Count(); TMP++) {
      lstrcpy(Buff, FoundedFiles->Item(TMP));
      if (!IsPersistentFile(Buff, PersistentList)) {
        GetRARFile(Buff);
        WriteLine(hFile, Buff);
      }
    }
    
    WriteLine(hFile, "");
    
    for (TMP = 0; TMP < PersistentList->Count(); TMP++) {
      lstrcpy(Buff, PersistentList->Item(TMP));
      GetRARFile(Buff);
      WriteLine(hFile, Buff);
    }
    
    CloseHandle(hFile);
    
    cout << "rarlist.txt file created." << endl;
    //cout << endl;
  }
  else {
    cout << "Error creating rarlist.txt file." << endl;
    //cout << endl;
  }
}

//===================================================================
VOID GenerateBAT(VOID)
{
  HANDLE hFile = CreateFile("packit.bat", GENERIC_WRITE, 
                            0, NULL, CREATE_ALWAYS, 0, 0);
  if (hFile != INVALID_HANDLE_VALUE) {
    //char Buff[] = "CALL ADD2RAR2L.BAT \"Site Update.RAR\" @rarlist.txt";
    char Buff[] = "\"C:\\Program Files\\WinRAR\\Rar.exe\" a \"Site Update.RAR\" @rarlist.txt";
    
    WriteLine(hFile, Buff);
    CloseHandle(hFile);
    
    cout << "packit.bat file created." << endl;
    cout << endl;
  }
  else {
    cout << "Error creating packit.bat file." << endl;
    cout << endl;
  }
}

//===================================================================
VOID PrintList(CCollection *FoundedFiles)
{
  DWORD TMP = 0;
  
  cout << "Founded files..." << endl;
  
  for (TMP = 0; TMP < FoundedFiles->Count(); TMP++) {
    //cout << FoundedFiles->Item(TMP) << endl;
  };
  
  cout << "Listed " << TMP << " items." << endl;
  cout << endl;
}

//===================================================================
VOID ExploreFolder(CCollection *FoundedFiles,
                   char        *szFolder)
{
  WIN32_FIND_DATA FD;
  ZeroMemory(&FD, sizeof(FD));
  
  char szMask[1024] = "\0";
  PathCombine(szMask, szFolder, "*.*");
  
  HANDLE hFind = FindFirstFile(szMask, &FD);
  if (hFind == INVALID_HANDLE_VALUE) return;
  
  BOOL RC = 0;
  do {
    char szFullFileName[1024] = "\0";
    PathCombine(szFullFileName, szFolder, FD.cFileName);
    
    if ((lstrcmp(FD.cFileName, ".") != 0) && 
        (lstrcmp(FD.cFileName, "..") != 0) &&
        ((GetFileAttributes(szFullFileName) & FILE_ATTRIBUTE_HIDDEN) == 0)) {
      
      if ((GetFileAttributes(szFullFileName) & FILE_ATTRIBUTE_DIRECTORY) != 0)
        ExploreFolder(FoundedFiles, szFullFileName);
      else {
        if ((GetFileAttributes(szFullFileName) & FILE_ATTRIBUTE_ARCHIVE) != 0)
          FoundedFiles->AddItem(szFullFileName);
      }
    }
    
    RC = FindNextFile(hFind, &FD);
  } while(RC);
  
  FindClose(hFind);
}

//===================================================================
int main(void)
{
  SetConsoleTitle("AJPapps - News list generator 2, ver. 1.00.0001");
  
  cout << "AJPapps - News list generator 2, ver. 1.00.0001" << endl;
  cout << "<Ё-¤  ? c? 2007. ?Rбўпй ?вбп ?аЁн<м." << endl;
  cout << endl;
  
  //=================================================================
  // Сначала делаем список всех файлов, которые могут подойти.
  cout << "Building file list..." << endl;
  cout << endl;
  
  CCollection *FoundedFiles = new CCollection;
  ExploreFolder(FoundedFiles, "\\");
  
  PrintList(FoundedFiles);
  
  //=================================================================
  // Теперь делаем список файлов, которые всегда меняются.
  CCollection *PersistentList = new CCollection;
  
  char ChangeLogFile[100] = "\0";
  GetChangelogFileName(ChangeLogFile);
  
  char ChangeLogFile2[200] = "\\news\\\0";
  lstrcat(ChangeLogFile2, ChangeLogFile);
  
  PersistentList->AddItem("\\index.htm");
  PersistentList->AddItem("\\about.htm");
  PersistentList->AddItem("\\lindachan_rss.xml");
  PersistentList->AddItem("\\lindachan_rss.old.xml");
  PersistentList->AddItem(ChangeLogFile2);
  PersistentList->AddItem("\\news\\old_news.htm");
  
  //=================================================================
  GenerateChangeLog(FoundedFiles, PersistentList);
  GenerateRARList(FoundedFiles, PersistentList);
  GenerateBAT();
  
  //=================================================================
  delete PersistentList;
  delete FoundedFiles;
  
  cout << "?RвRўR ^_^" << endl;
  return 0;
}

А вот только что написанный скрипт. Кода слегка меньше, зато он читается лучше. Некоторые функции появились из-за того что VBsсript не поддерживает Format(), что б им пусто было >_<

Option Explicit

Const AppTitle = "AJPapps - News list generator 3"
Const AppFullTitle = "AJPapps - News list generator 3, ver. 1.00.0000"

Const BasePath = "X:\~~~Utils\"

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Const Normal = 0
Const ReadOnly = 1
Const Hidden = 2
Const System = 4
Const Volume = 8
Const Directory = 16
Const Archive = 32
Const Alias = 64
Const Compressed = 128 

'====================================================================

MsgBox AppFullTitle & vbCrLf & _
       "Линда Кайе 2008. Посвящается Ариэль." & vbCrLf & _
       vbCrLf & _
       "Этот скрипт создаст список изменившихся файлов, а также " & _
       "файлы необходимые для их упаковки.", _
       vbInformation, AppTitle

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")

' Сначала делаем список всех файлов, которые могут подойти.
Dim FoundedFiles
Set FoundedFiles = New Collection

' При отладке в Дане ставить X:\ !!!
ExploreFolder FoundedFiles, "\"
'FoundedFiles.DebugOut

' Теперь делаем список файлов, которые всегда меняются.
Dim PersistentList
Set PersistentList = New Collection

PersistentList.Add "\index.htm"
PersistentList.Add "\about.htm"
PersistentList.Add "\lindachan_rss.xml"
PersistentList.Add "\lindachan_rss.old.xml"
PersistentList.Add "\news\" & GetChangelogFileName()
PersistentList.Add "\news\old_news.htm"
'PersistentList.DebugOut

' А теперь генерируем сами файлы...
GenerateChangeLog FoundedFiles, PersistentList
GenerateRARList FoundedFiles, PersistentList
GenerateBAT

MsgBox "Готово ^_^", vbInformation, AppTitle
WScript.Quit

'====================================================================
Public Sub ExploreFolder(ByRef FoundedFiles, _
                         ByVal StartFolder)
  Dim Folder
  Set Folder = FSO.GetFolder(StartFolder)
  
  Dim Files
  Set Files = Folder.Files
  
  Dim SubFolders
  Set SubFolders = Folder.SubFolders
  
  Dim File
  Dim Attr
  
  For Each File In Files
    Attr = File.Attributes
    If (Attr And Hidden) = 0 Then
      If (Attr And Archive) <> 0 Then
        FoundedFiles.Add FSO.BuildPath(StartFolder, File.Name)
      End If
    End If
  Next
  
  Dim SubFolder
  
  For Each SubFolder In SubFolders
    Attr = SubFolder.Attributes
    If (Attr And Hidden) = 0 Then
      ExploreFolder FoundedFiles, FSO.BuildPath(StartFolder, SubFolder.Name)
    End If
  Next
End Sub

'====================================================================
Function GetChangelogFileName()
  GetChangelogFileName = Format(Year(Now), 4) & "_" & _
                         Format(Month(Now), 2) & "_" & _
                         Format(Day(Now), 2) & ".htm"
End Function

Function Format(ByVal Num, ByVal Width)
  Dim TXT
  
  TXT = CStr(Num)
  Do While Len(TXT) < Width
    TXT = "0" & TXT
  Loop
  
  Format = TXT
End Function

'====================================================================
Sub GenerateBAT()
  On Error Resume Next
  
  Dim OutFile
  Set OutFile = FSO.OpenTextFile(BasePath & "packit.bat", ForWriting, True)
  
  'OutFile.WriteLine "CALL ADD2RAR2L.BAT ""Site Update.RAR"" @rarlist.txt"
  OutFile.WriteLine """C:\Program Files\WinRAR\Rar.exe"" a ""Site Update.RAR"" @rarlist.txt"
  
  If Err Then
    MsgBox "Не удаётся создать файл packit.bat." & vbCrLf & _
           vbCrLf & _
           "Number:      " & Err.Number & vbCrLf & _
           "Description: " & Err.Description, _
           vbCritical, AppTitle
  End If
End Sub

'====================================================================
Sub GenerateRARList(ByRef FoundedFiles, _
                    ByRef PersistentList)
  Dim OutFile
  Dim TMP
  
  On Error Resume Next
  
  Set OutFile = FSO.OpenTextFile(BasePath & "rarlist.txt", ForWriting, True)
  
  For TMP = 0 To FoundedFiles.Count - 1
    If Not IsPersistentFile(FoundedFiles(TMP), PersistentList) Then
      OutFile.WriteLine GetRARFile(FoundedFiles(TMP))
    End If
  Next
  
  OutFile.WriteLine ""
  
  For TMP = 0 To PersistentList.Count - 1
    OutFile.WriteLine GetRARFile(PersistentList(TMP))
  Next
  
  If Err Then
    MsgBox "Не удаётся создать файл rarlist.txt." & vbCrLf & _
           vbCrLf & _
           "Number:      " & Err.Number & vbCrLf & _
           "Description: " & Err.Description, _
           vbCritical, AppTitle
  End If
End Sub

'====================================================================
Function GetRARFile(ByVal TXT)
  GetRARFile = Replace(TXT, "\", "/")
End Function

Function IsPersistentFile(ByVal FileName, ByRef PersistentList)
  Dim TMP
  
  For TMP = 0 To PersistentList.Count - 1
    If UCase(FileName) = UCase(PersistentList(TMP)) Then
      IsPersistentFile = True
      Exit Function
    End If
  Next
  
  IsPersistentFile = False
End Function

'====================================================================
Sub GenerateChangeLog(ByRef FoundedFiles, _
                      ByRef PersistentList)
  Dim OutFile
  Dim TMP
  
  On Error Resume Next
  
  Set OutFile = FSO.OpenTextFile(BasePath & GetChangelogFileName(), ForWriting, True)
  
  OutFile.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"""
  OutFile.WriteLine "                      ""http://www.w3c.org/TR/REC-html40/strict.dtd"">"
  OutFile.WriteLine "<HTML LANG=""ru"">"
  OutFile.WriteLine "<HEAD>"
  OutFile.WriteLine "  <META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=windows-1251"">"
  OutFile.WriteLine "  <META HTTP-EQUIV=""Generator""    CONTENT=""" & AppFullTitle & """>"
  OutFile.WriteLine "  <META HTTP-EQUIV=""Author""       CONTENT=""Линда Кайе"">"
  OutFile.WriteLine "  <META HTTP-EQUIV=""Copyright""    CONTENT=""Линда Кайе 2008. Посвящается Ариэль."">"
  OutFile.WriteLine "  <META HTTP-EQUIV=""Reply-To""     CONTENT=""lindakaioh@mail.ru"">"
  OutFile.WriteLine "  <META HTTP-EQUIV=""ProgId""       CONTENT=""ANPFile"">"
  OutFile.WriteLine "  "
  OutFile.WriteLine "  <TITLE>Мой маленький мир :: Changelog " & GetTitle() & "</TITLE>"
  OutFile.WriteLine "  "
  OutFile.WriteLine "  <LINK REL=""SHORTCUT ICON"" HREF=""/favicon.ico"" TYPE=""image/x-icon"">"
  OutFile.WriteLine "  <LINK REL=""ALTERNATE"" HREF=""http://purl.oclc.org/Linda_Kaioh/Homepage/lindachan_rss.xml"""
  OutFile.WriteLine "        TYPE=""application/rss+xml"" TITLE=""RSS 2.00"">"
  OutFile.WriteLine "  <LINK REL=""STYLESHEET"" HREF=""/lindachan.css"" TYPE=""text/css"">"
  OutFile.WriteLine "</HEAD>"
  OutFile.WriteLine "<BODY>"
  OutFile.WriteLine ""
  OutFile.WriteLine "<PRE STYLE=""padding:0px;margin:0px;font:10pt 'Courier New','Andale Mono',monospace;"">"
  
  OutFile.WriteLine "<B># " & GetTitle() & "</B>"
  OutFile.WriteLine "<B># ==========</B>"
  OutFile.WriteLine ""
  
  For TMP = 0 To FoundedFiles.Count - 1
    If Not IsPersistentFile(FoundedFiles(TMP), PersistentList) Then
      OutFile.WriteLine GetLink(FoundedFiles(TMP))
    End If
  Next
  
  OutFile.WriteLine ""
  OutFile.WriteLine "<B># Всегда обновляется</B>"
  OutFile.WriteLine ""
  
  For TMP = 0 To PersistentList.Count - 1
    OutFile.WriteLine GetLink(PersistentList(TMP))
  Next
  
  OutFile.WriteLine ""
  OutFile.WriteLine "<B># ==========</B>"
  OutFile.WriteLine "<B># Generator: " & AppFullTitle & "</B>"
  OutFile.WriteLine "<B># Date:      " & GetDateTime() & "</B>"
  
  OutFile.WriteLine "</PRE>"
  OutFile.WriteLine "</BODY>"
  OutFile.WriteLine "</HTML>"
  
  If Err Then
    MsgBox "Не удаётся создать файл " & GetChangelogFileName() & "." & vbCrLf & _
           vbCrLf & _
           "Number:      " & Err.Number & vbCrLf & _
           "Description: " & Err.Description, _
           vbCritical, AppTitle
  End If
End Sub

'====================================================================
Function GetTitle()
  GetTitle = Day(Now) & "." & _
             Format(Month(Now), 2) & "." & _
             Format(Year(Now), 4)
End Function

Function GetLink(ByVal FileName)
  GetLink = "<A HREF=""" & GetRARFile(FileName) & """>" & _
            GetRARFile(FileName) & "</A>"
End Function

Function GetDateTime()
  Dim AMPM
  Dim wHour
  
  wHour = Hour(Now)
  If wHour = 0 Then
    ST.wHour = 12
    AMPM = "AM"
  ElseIf wHour > 12 Then
    wHour = wHour - 12
    AMPM = "PM"
  ElseIf wHour = 12 Then
    AMPM = "PM"
  Else
    AMPM = "AM"
  End If
  
  GetDateTime = Day(Now) & "." & _
                Format(Month(Now), 2) & "." & _
                Format(Year(Now), 4) & " @ " & _
                wHour & ":" & _
                Format(Minute(Now), 2) & ":" & _
                Format(Second(Now), 2) & " " & _
                AMPM
End Function

'====================================================================
' Объект, пытающийся эмулировать коллекции VB. Есть проблема с 
' уникальным значением и возможным переполнением...
'====================================================================
Class Collection
  ' Объект словаря
  Private mDic
  Private mUniqueKey
  
  Private Sub Class_Initialize   ' Setup Initialize event.
    'MsgBox("TestClass started")
    Set mDic = CreateObject("Scripting.Dictionary")
    mUniqueKey = 0
  End Sub
  
  Private Sub Class_Terminate   ' Setup Terminate event.
    'MsgBox("TestClass terminated")
    Set mDic = Nothing
  End Sub
  
  Public Sub Add(ByVal Item)
    mDic.Add CStr(mUniqueKey), Item
    mUniqueKey = mUniqueKey + 1
  End Sub
  
  Public Default Function Item(ByVal Index)
    Dim Key
    Dim Keys
    
    Keys = mDic.Keys
    Key = Keys(Index)
    
    Item = mDic.Item(Key)
  End Function
  
  Public Function Count()
    Count = mDic.Count
  End Function
  
  Public Sub Clear()
    mDic.RemoveAll
  End Sub
  
  Public Sub Remove(ByVal Index)
    Dim Key
    Dim Keys
    
    Keys = mDic.Keys
    Key = Keys(Index)
    
    mDic.Remove Key
  End Sub
  
  ' Отладочная функция
  Public Sub DebugOut()
    Dim TMP
    
    WScript.Echo "Collection contents..."
    
    For TMP = 0 To Me.Count - 1
      WScript.Echo "  " & Me.Item(TMP)
    Next
    
    WScript.Echo "Listed " & TMP & " items."
    WScript.Echo ""
  End Sub
End Class

Что, гыгы? Рукопашная CMC в миниатюре ^^

URL

14:36

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-01-47
#original-date: 22.11.2008 Sat
#original-time: 1:47 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

А вот и коллекция:

Class Collection
  ' Объект словаря
  Private mDic
  Private mUniqueKey
  
  Private Sub Class_Initialize   ' Setup Initialize event.
    'MsgBox("TestClass started")
    Set mDic = CreateObject("Scripting.Dictionary")
    mUniqueKey = 0
  End Sub
  
  Private Sub Class_Terminate   ' Setup Terminate event.
    'MsgBox("TestClass terminated")
    Set mDic = Nothing
  End Sub
  
  Public Sub Add(ByVal Item)
    mDic.Add CStr(mUniqueKey), Item
    mUniqueKey = mUniqueKey + 1
  End Sub
  
  Public Default Function Item(ByVal Index)
    Dim Key
    Dim Keys
    
    Keys = mDic.Keys
    Key = Keys(Index)
    
    Item = mDic.Item(Key)
  End Function
  
  Public Function Count()
    Count = mDic.Count
  End Function
  
  Public Sub Clear()
    mDic.RemoveAll
  End Sub
  
  Public Sub Remove(ByVal Index)
    Dim Key
    Dim Keys
    
    Keys = mDic.Keys
    Key = Keys(Index)
    
    mDic.Remove Key
  End Sub
End Class

Dim A, TMP
Set A = New Collection

A.Add "Ariel" ' 0
A.Add "Linda" ' 1
A.Add "Anna"  ' 2
A.Add "Loush" ' 3
A.Add "Alice" ' 4

For TMP = 0 To A.Count - 1
  MsgBox A(TMP)
Next

A.Remove 3
A.Remove 3
A.Remove 0

For TMP = 0 To A.Count - 1
  MsgBox A(TMP)
Next

Правда не обошлось без нехорошего но...

URL

14:36

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-01-24
#original-date: 22.11.2008 Sat
#original-time: 1:24 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

День открытий... Вспомнила про создание классов...

Class B
  Public Sub Hi
    MsgBox "Hi!"
  End Sub
End Class

Dim A
Set A = New B
A.Hi

Одно плохо. Вместо Collection там Dictionary. Крутая штука, но не заменит Collection - работает иначе...

URL

14:36

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-01-18
#original-date: 22.11.2008 Sat
#original-time: 1:18 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

Ого! Вот это я монстер!

typedef struct FILE_NAME_ELEMENT {
  char szFileName[MAX_PATH];
  FILE_NAME_ELEMENT *lpNextElement;
} FILE_NAME_ELEMENT;

class CCollection {
  public:
    CCollection();
    ~CCollection();
    
    DWORD Count(VOID);
    VOID AddItem(LPSTR szFileName);
    LPSTR Item(DWORD dwIndex);
  
  private:
    FILE_NAME_ELEMENT *lpRootItem;
    FILE_NAME_ELEMENT *lpLastItem;
    DWORD nItems;
};

//===================================================================
CCollection::CCollection(VOID)
{
  lpRootItem = NULL;
  lpLastItem = NULL;
  nItems = 0;
}

CCollection::~CCollection(VOID)
{
  FILE_NAME_ELEMENT *lpCurr = NULL;
  DWORD TMP = 0;
  
  while(lpRootItem) {
    TMP++;
    
    lpCurr = lpRootItem;
    lpRootItem = lpRootItem->lpNextElement;
    
    delete lpCurr;
  };
  
  if (TMP != nItems) MsgBox("Aaaa!!!");
}

//===================================================================
DWORD CCollection::Count(VOID)
{
  return nItems;
}

//===================================================================
VOID CCollection::AddItem(LPSTR szFileName)
{
  FILE_NAME_ELEMENT *TmpItem = new FILE_NAME_ELEMENT;
  lstrcpy(TmpItem->szFileName, szFileName);
  TmpItem->lpNextElement = NULL;
  
  nItems++;
  
  if (lpLastItem)
    lpLastItem->lpNextElement = TmpItem;
  else
    lpRootItem = TmpItem;
  
  lpLastItem = TmpItem;
}

//===================================================================
LPSTR CCollection::Item(DWORD dwIndex)
{
  FILE_NAME_ELEMENT *TmpItem = NULL;
  
  if (dwIndex < 0 || dwIndex >= nItems) return NULL;
  
  TmpItem = lpRootItem;
  for (DWORD TMP = 1; TMP <= dwIndex; TMP++) {
    TmpItem = TmpItem->lpNextElement;
  }
  
  return TmpItem->szFileName;
}

Связный список эмулирует VB Collection. И не придерёшься... Вот каждый раз забываю о том что писала такое...

#music: Need For Speed: High Stakes\No Remorse

URL

14:36

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3041-01-06
#original-date: 22.11.2008 Sat
#original-time: 1:06 AM
#original-day: 3041
#original-host: WinXP Prof SP2 (Build 2600)

Мда... Эволюция... Сначала была такая программа на VB. Тогда я ещё отслеживала изменения файлов по дате.

Attribute VB_Name = "modMain"
Option Explicit

' Need for Setup Toolkit...
Declare Sub Dummy Lib "AJPappsSupport0100.DLL" ()

'====================================================================
Public Sub Main()
  ajpConsole.WriteStandardHeader App, True
  
  BuildFoundList
  
  If asIsInIDE Then ajpConsole.Pause
End Sub

'====================================================================
Private Sub BuildFoundList()
  Dim FF As ajpFoundedFiles
  Set FF = New ajpFoundedFiles
  
  ajpConsole.WriteText "Building file list..."
  
  Dim RC As BOOL
  RC = FF.Refresh("\", "*.*")
  
  If RC Then
    ajpConsole.WriteLine " Ok!"
    ajpConsole.WriteLine
    
    ResetFileTimes FF
    
    ajpConsole.WriteLine "It's done!"
  Else
    ajpConsole.WriteLine
    ajpConsole.WriteLine "Error: files not founs..."
  End If
  
  Set FF = Nothing
End Sub

'====================================================================
Private Sub ResetFileTimes(ByVal FF As ajpFoundedFiles)
  Dim TMP As FoundedFile
  
  For Each TMP In FF
    If TMP.Childs.HasSubItems Then
      ResetFileTimes TMP.Childs
    Else
      Dim FileName As BStr
      
      FileName = asBuildFileName(TMP.Path, TMP.FileName)
      ResetFileTime FileName
    End If
  Next TMP
End Sub

'====================================================================
Private Sub ResetFileTime(ByVal FileName As BStr)
  Dim FTL As FILETIME
  Dim FT As FILETIME
  Dim ST As SYSTEMTIME
  Dim RC As Long
  
  ST.wDay = 1
  ST.wMonth = 1
  ST.wYear = 1969
  ST.wHour = 12
  ST.wMinute = 0
  ST.wSecond = 0
  ST.wMilliseconds = 0
  
  RC = SystemTimeToFileTime(ST, FTL)
  If RC = 0 Then
    WriteError "can't convert SYSTEMTIME to FILE_TIME!", FileName
    Exit Sub
  End If
  
  RC = LocalFileTimeToFileTime(FTL, FT)
  If RC = 0 Then
    WriteError "can't convert local FILE_TIME to system FILE_TIME!", FileName
    Exit Sub
  End If
  
  Dim hFile As API_HANDLE
  Dim DesiredAccess As Long
  
  If asIsHostWinNT Then
    DesiredAccess = FILE_WRITE_ATTRIBUTES
  Else
    DesiredAccess = FILE_GENERIC_WRITE
  End If
  
  hFile = CreateFile(FileName, DesiredAccess, _
                     FILE_SHARE_READ And FILE_SHARE_WRITE, _
                     0, OPEN_EXISTING, 0, 0)
  If hFile = INVALID_HANDLE_VALUE Then
    WriteError "can't open file to write new attributes!", FileName
    Exit Sub
  End If
  
  RC = SetFileTime(hFile, FT, FT, FT)
  If RC = 0 Then
    CloseHandle hFile
    WriteError "can't set file time - SetFileTime() failed!", FileName
    Exit Sub
  End If
  
  CloseHandle hFile
End Sub

'====================================================================
Private Sub WriteError(ByVal Message As BStr, ByVal FileName As BStr)
  ajpConsole.WriteLine FileName
  ajpConsole.WriteLine "Error: " & Message
  ajpConsole.WriteLine
End Sub

Потом на сессии я решила изменить алгоритм и положиться на файловые атрибуты, и в итоге написала на C такую программу:

#include <AJP System.H>
#include <AJP Console.H>
#include <xShlWAPI.H>

//===================================================================
VOID ExploreFolder(char *szFolder)
{
  WIN32_FIND_DATA FD;
  ZeroMemory(&FD, sizeof(FD));
  
  char szMask[1024] = "\0";
  PathCombine(szMask, szFolder, "*.*");
  
  HANDLE hFind = FindFirstFile(szMask, &FD);
  if (hFind == INVALID_HANDLE_VALUE) return;
  
  BOOL RC = 0;
  do {
    char szFullFileName[1024] = "\0";
    PathCombine(szFullFileName, szFolder, FD.cFileName);
    
    if ((lstrcmp(FD.cFileName, ".") != 0) && 
        (lstrcmp(FD.cFileName, "..") != 0) &&
        ((GetFileAttributes(szFullFileName) & FILE_ATTRIBUTE_HIDDEN) == 0)) {
      
      DWORD dwAttr = GetFileAttributes(szFullFileName);
      dwAttr &= ~FILE_ATTRIBUTE_ARCHIVE;
      if (SetFileAttributes(szFullFileName,dwAttr) == 0) {
        cout << szFullFileName << endl;
        cout << "Error: can't clear Archive attribute.";
        cout << endl;
      }
      
      if ((GetFileAttributes(szFullFileName) & FILE_ATTRIBUTE_DIRECTORY) != 0)
        ExploreFolder(szFullFileName);
    }
    
    RC = FindNextFile(hFind, &FD);
  } while(RC);
  
  FindClose(hFind);
}

//===================================================================
int main(void)
{
  SetConsoleTitle("AJPapps - Discard site changes 2, ver. 1.00.0000");
  
  cout << "AJPapps - Discard site changes 2, ver. 1.00.0000" << endl;
  cout << "Линда Кайе 2007. Посвящается Ариэль." << endl;
  cout << endl;
  
  //char TXT[1024] = "\0";
  //GetCurrentDirectory(1023, TXT);
  //cout << TXT << endl << endl;
  
  ExploreFolder("\\");
  
  cout << "Готово ^_^" << endl;
  return 0;
}

Кода меньше, да, но модифицировать было не так просто почему-то. По крайней мере я решила переписать третью версию программы на VBS:

Option Explicit

Const AppTitle = "AJPapps - Discard site changes 3"
Const AppFullTitle = "AJPapps - Discard site changes 3, ver. 1.00.0000"

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Const Normal = 0
Const ReadOnly = 1
Const Hidden = 2
Const System = 4
Const Volume = 8
Const Directory = 16
Const Archive = 32
Const Alias = 64
Const Compressed = 128 

'====================================================================

If MsgBox(AppFullTitle & vbCrLf & _
          "Линда Кайе 2008. Посвящается Ариэль." & vbCrLf & _
          vbCrLf & _
          "ВНИМАНИЕ! Этот скрипт обнулит все сведения об изменившихся " & _
          "и подлежащих выгрузке на сайт файлах. Продолжить?", _
          vbQuestion + vbYesNo, AppTitle) = vbYes Then
  Dim FSO
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  ' Тут в оригинале был просто слэш. Но для отладки из Даны оставлю 
  ' ещё и букву диска, чтобы не запутаться с текущим каталогом...
  ExploreFolder "X:\"
  
  MsgBox "Готово ^_^", vbInformation, AppTitle
End If

WScript.Quit

'====================================================================
Public Sub ExploreFolder(StartFolder)
  Dim Folder
  Set Folder = FSO.GetFolder(StartFolder)
  
  Dim Files
  Set Files = Folder.Files
  
  Dim SubFolders
  Set SubFolders = Folder.SubFolders
  
  Dim File
  Dim Attr
  
  For Each File In Files
    Attr = File.Attributes
    If (Attr And Hidden) = 0 Then
      On Error Resume Next
      
      Attr = Attr And Not Archive
      File.Attributes = Attr
      
      If Err Then
        If MsgBox("Не удаётся отчистить архивный атрибут." & vbCrLf & _
                  vbCrLf & _
                  "Number:      " & Err.Number & vbCrLf & _
                  "Description: " & Err.Description & vbCrLf & _
                  vbCrLf & _
                  "Имя файла:" & vbCrLf & _
                  FSO.BuildPath(File.Path, File.Name), _
                  vbCritical + vbOkCancel, AppTitle) = vbCancel Then
          WScript.Quit
        End If
      End If
      
      On Error Goto 0
    End If
  Next
  
  Dim SubFolder
  
  For Each SubFolder In SubFolders
    Attr = SubFolder.Attributes
    If (Attr And Hidden) = 0 Then
      ExploreFolder FSO.BuildPath(StartFolder, SubFolder.Name)
    End If
  Next
End Sub

Кода опять больше, но там по большей части фансервис ^^ Зато можно править везде и всегда ^^

#music: Need For Speed: High Stakes\No Remorse

URL